TwitterPost

Module1.bas

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Long
Const WM_SETTEXT = &HC
Const BM_CLICK = &HF5

Private WithEvents ie As InternetExplorer
Private flg As Boolean

Sub Main()

    flg = False
    Set ie = New InternetExplorer
    ie.Visible = True
    ie.Navigate "https://twitter.com"
    
    Do While ie.busy Or ie.ReadyState <> READYSTATE_COMPLETE
        DoEvents
        Sleep 1&
    Loop

    'HTMLDivElement
    ie.document.all("tweet-box-mini-home-profile").Focus

    '画像を追加ボタンをクリック
    ie.document.forms(2).Item("media_empty").Click
    Do While ie.busy Or flg = False
        DoEvents
        Sleep 1&
    Loop
    ie.document.all("tweet-box-mini-home-profile").Focus
    With New DataObject
         .SetText "hoge"
         .PutInClipboard
    End With
    ie.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT

    'ツイートする
    ie.document.getElementsByTagName("button")(11).Click
        
End Sub


Private Sub ie_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)

    If flg Then Exit Sub
    Dim hDlg As LongPtr
    hDlg = FindWindow("#32770", "アップロードするファイルの選択")
    If hDlg = 0 Then Exit Sub

    Dim hCmb As LongPtr
    hCmb = FindWindowEx(hDlg, 0, "ComboBoxEx32", vbNullString)
    If hCmb = 0 Then Exit Sub
    SendMessage hCmb, WM_SETTEXT, 0, ByVal "パス"

    Dim hBtn As LongPtr
    hBtn = FindWindowEx(hDlg, 0, "Button", "開く(&O)")
    If hBtn = 0 Then Exit Sub
    SendMessage hBtn, BM_CLICK, 0, ByVal 0&

    flg = True
End Sub