我正在尝试创建一个从超链接下载文件的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