投稿‎ > ‎

VBAで遊ぼう⑨

posted Jul 11, 2016, 11:26 PM by Zhang Wenxu
Public Sub DevNetAddActiveWorkbook()
    Dim ie As InternetExplorer
    Dim btnAdd As Object
    Dim btnFile1 As Object
    Dim btnSubmit As Object
    Dim devnetID As String
    Dim seq As String

    ActiveWorkbook.Save

    Set ie = getProcenter
    Set btnAdd = getLinkByInnerText(ie, "ファイル登録")
    if btnAdd Is Nothing Then
        MsgBox "ファイル登録画面を開いてください。"
        Exit Sub
    End If
    Call btnAdd.Click

    Set. btnFile1 = getInputByName(ie, "File1")
    if btnFile1 Is Nothing Then
        MsgBox "ファイル登録ボタンがないです。"
        Exit Sub
    End If
        ie.document.Script.setTimeout "javascript:" & vbCrLf & _
             "(function(){" & vbCrLf & _
             "    try{" & vbCrLf & _
             "        var inputs = document.frames('main').document.getElementsByTagName('INPUT');" & vbCrLf & _
             "        for(var i = 0; i < inputs.length - 1; i++){" & vbCrLf & _
             "             if(inputs[i].name.substring(0, 8) == 'File1'){" & vbCrLf & _
             "                  inputs[i].click();" & vbCrLf & _
             "                  break;" & vbCrLf & _
             "             }" & vbCrLf & _ 
             "         }" & vbCrLf & _
             "     }catch(e){" & vbCrLf & _
             "         alert(e);" & vbCrLf & _
             "     }" & vbCrLf & _
             "}())", 100
    Sleep 1000
    Call setDialogInputValue("アップロードするファイルの選択”, "ファイル名(N):", ActiveWorkbook.FullName)
    Call clickDialogButton("アップロードするファイルの選択”, "開く(O)")
    Set btnSubmit = getInputByName(ie, "SUBMIT_EXEC")
    if btnSubmit Is Nothing Then
        MsgBox "サブミットボタンがないです。")
        Exit Sub
    End If
    Call btnSubmit.Click
    Call WaitIE(ie)
    devnetID = getValueByName(ie, "ID")
    seq = getValueByName(ie, "SEQ")
    Call saveCustomProp(ActiveWorkbook, C_DEVNET_ID, devnetID)
    Call saveCustomProp(ActiveWorkbook, C_DEVNET_SEQ, seq)
 End Sub
    
Comments