VBA - 更改保存路径镶边

时间:2014-07-01 06:38:17

标签: excel vba google-chrome excel-vba

我正在尝试创建一个从超链接下载文件的VBA宏。宏观工作完美,没有一个功能。我希望宏放置一个"下载路径"在一个单元格中让chrome改变这一点。问题是Chrome只使用Chrome中设置的下载路径..对此有什么想法?

Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Sub run()
    Dim n As Long
    Dim q As Long
    Dim currentWorkBook As Workbook
    Dim chromePath As String, savePath As String, saveName As String
    Dim formCaption As String
    Dim downloadWindow As Long, subWindow As Long, editWindow As Long, formButton As Long, saveButton As Long



    Set currentWorkBook = ActiveWorkbook

    chromePath = Worksheets("Main").Cells(3, 2).Value
    savePath = Worksheets("Main").Cells(2, 2).Value

    Application.EnableEvents = False
    Application.ScreenUpdating = False


    saveName = Worksheets("Main").Cells(6, 3).Value
    If saveName = "Select name to save" Then
        MsgBox ("Please specify what name should be used when saving.")
        Exit Sub
    End If

    MsgBox (saveName)
    If (saveName = "Name") Then
        q = 2
    Else
        q = 3
    End If
    With Worksheets("Document List")


        n = 2
        Do While .Cells(n, 1).Value <> ""
            Shell (chromePath & " -url " & .Cells(n, 1).Value)

            downloadWindow = 0
            subWindow = 0
            editWindow = 0
            formButton = 0
            saveButton = 0

            'Delete the old file before downloading.
            Dim fileName As String
            fileName = Dir(savePath & .Cells(n, q).Value & ".*")
            On Error Resume Next
            If fileName <> "" Then Kill savePath & fileName

            Dim timeStart As Long
            timeStart = Timer
            Do Until downloadWindow <> 0 Or Timer > timeStart + 10
                downloadWindow = FindWindow(vbNullString, "Save As")
            Loop

            'Update save path
            timeStart = Timer
            Do Until editWindow <> 0 Or Timer > timeStart + 10
                subWindow = FindWindowEx(downloadWindow, ByVal 0&, "WorkerW", vbNullString)
                subWindow = FindWindowEx(subWindow, ByVal 0&, "ReBarWindow32", vbNullString)
                subWindow = FindWindowEx(subWindow, ByVal 0&, "Address Band Root", vbNullString)
                subWindow = FindWindowEx(subWindow, ByVal 0&, "msctls_progress32", vbNullString)
                subWindow = FindWindowEx(subWindow, ByVal 0&, "Breadcrumb Parent", vbNullString)
                editWindow = FindWindowEx(subWindow, ByVal 0&, "ToolbarWindow32", vbNullString)
            Loop

            SendMessageByString editWindow, WM_SETTEXT, 0, "C:\Users\USER\Downloads\"
            editWindow = 0

            'Find the save name field
            timeStart = Timer
            Do Until editWindow <> 0 Or Timer > timeStart + 10
                subWindow = FindWindowEx(downloadWindow, ByVal 0&, "DUIViewWndClassName", vbNullString)
                subWindow = FindWindowEx(subWindow, ByVal 0&, "DirectUIHWND", vbNullString)
                subWindow = FindWindowEx(subWindow, ByVal 0&, "FloatNotifySink", vbNullString)
                subWindow = FindWindowEx(subWindow, ByVal 0&, "ComboBox", vbNullString)
                editWindow = FindWindowEx(subWindow, ByVal 0&, "Edit", vbNullString)
            Loop

            'Update the save name field if found
            If editWindow <> 0 And downloadWindow <> 0 And .Cells(n, q).Value <> "" Then
                Sleep 500
                SendMessageByString editWindow, WM_SETTEXT, 0, .Cells(n, q).Value
            ElseIf .Cells(n, q).Value = "" Then
                Sleep 500
            Else

            End If

            'Find the save button by looping through all available buttons and looking for "Save"
            formButton = FindWindowEx(downloadWindow, ByVal 0&, "Button", vbNullString)
            If formButton <> 0 Then
                'Get the caption of the child window
                formCaption = String(GetWindowTextLength(formButton) + 1, Chr$(0))
                GetWindowText formButton, formCaption, Len(formCaption)

                Do While formButton <> 0
                    If InStr(1, formCaption, "Save") Then
                        saveButton = formButton
                        Exit Do
                    End If

                    formButton = FindWindowEx(downloadWindow, formButton, "Button", vbNullString)
                    formCaption = String(GetWindowTextLength(formButton) + 1, Chr$(0))
                    GetWindowText formButton, formCaption, Len(formCaption)
                Loop
            End If

            'Press the save button if found
            If saveButton <> 0 Then
                SendMessage saveButton, BM_CLICK, 0, 0
            Else

            End If

            n = n + 1
        Loop
    End With
    Exit Sub

End Sub

0 个答案:

没有答案