将网页保存为PDF到某个目录
我有它在哪里将打开Internet Explorer给用户另存为框，然后退出。 但是，我宁愿如果不是用户必须导航到正确的文件夹，该目录来自工作表中的单元格，并将网页保存为PDF。 我安装了完整的Adobe。 代码：
Sub WebSMacro() Dim IE As Object Dim Webloc As String Dim FullWeb As String Webloc = ActiveSheet.Range("B39").Value FullWeb = "http://www.example.com=" & Webloc Set IE = CreateObject("InternetExplorer.Application") IE.Visible = True IE.Navigate FullWeb Do While IE.Busy Application.Wait DateAdd("s", 1, Now) Loop IE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER Application.Wait DateAdd("s", 10, Now) IE.Quit Set IE = Nothing End Sub 今天，你赢得互联网！
由于我想深入学习这些知识以获取个人利益，因此我使用了我在评论中引用的第二个链接中的代码，让代码按照您的定义工作。
代码将inputFilePath和Name（从单元格收集）到SaveAs对话框中，并将其保存到input的位置。
这里是主要的子（与评论）：
Sub WebSMacro() 'set default printer to AdobePDF Dim WSHNetwork As Object Set WSHNetwork = CreateObject("WScript.Network") WSHNetwork.SetDefaultPrinter "Adobe PDF" 'get pdfSave as Path from cell range Dim sFolder As String sFolder = Sheets("Sheet1").Range("A1") 'assumes folder save as path is in cell A1 of mySheets Dim IE As Object Dim Webloc As String Dim FullWeb As String Webloc = ActiveSheet.Range("B39").Value FullWeb = "http://www.example.com" & Webloc Set IE = CreateObject("InternetExplorer.Application") With IE .Visible = True .Navigate FullWeb Do While .Busy Application.Wait DateAdd("s", 1, Now) Loop .ExecWB 6, 2 'OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER Application.Wait DateAdd("s", 3, Now) Call PDFPrint(sFolder & Webloc & ".pdf") .Quit End With Set IE = Nothing End Sub
您还需要将这两个子目录放在工作簿中（可以是与主子目录（或其他子目录）相同的模块）：
Sub PDFPrint(strPDFPath As String) 'Prints a web page as PDF file using Adobe Professional. 'API functions are used to specify the necessary windows while 'a WMI function is used to check printer's status. 'By Christos Samaras 'http://www.myengineeringworld.net Dim Ret As Long Dim ChildRet As Long Dim ChildRet2 As Long Dim ChildRet3 As Long Dim comboRet As Long Dim editRet As Long Dim ChildSaveButton As Long Dim PDFRet As Long Dim PDFName As String Dim StartTime As Date 'Find the main print window. StartTime = Now() Do Until Now() > StartTime + TimeValue("00:00:05") Ret = 0 DoEvents Ret = FindWindow(vbNullString, "Save PDF File As") If Ret <> 0 Then Exit Do Loop If Ret <> 0 Then SetForegroundWindow (Ret) 'Find the first child window. StartTime = Now() Do Until Now() > StartTime + TimeValue("00:00:05") ChildRet = 0 DoEvents ChildRet = FindWindowEx(Ret, ByVal 0&, "DUIViewWndClassName", vbNullString) If ChildRet <> 0 Then Exit Do Loop If ChildRet <> 0 Then 'Find the second child window. StartTime = Now() Do Until Now() > StartTime + TimeValue("00:00:05") ChildRet2 = 0 DoEvents ChildRet2 = FindWindowEx(ChildRet, ByVal 0&, "DirectUIHWND", vbNullString) If ChildRet2 <> 0 Then Exit Do Loop If ChildRet2 <> 0 Then 'Find the third child window. StartTime = Now() Do Until Now() > StartTime + TimeValue("00:00:05") ChildRet3 = 0 DoEvents ChildRet3 = FindWindowEx(ChildRet2, ByVal 0&, "FloatNotifySink", vbNullString) If ChildRet3 <> 0 Then Exit Do Loop If ChildRet3 <> 0 Then 'Find the combobox that will be edited. StartTime = Now() Do Until Now() > StartTime + TimeValue("00:00:05") comboRet = 0 DoEvents comboRet = FindWindowEx(ChildRet3, ByVal 0&, "ComboBox", vbNullString) If comboRet <> 0 Then Exit Do Loop If comboRet <> 0 Then 'Finally, find the "edit property" of the combobox. StartTime = Now() Do Until Now() > StartTime + TimeValue("00:00:05") editRet = 0 DoEvents editRet = FindWindowEx(comboRet, ByVal 0&, "Edit", vbNullString) If editRet <> 0 Then Exit Do Loop 'Add the PDF path to the file name combobox of the print window. If editRet <> 0 Then SendMessage editRet, WM_SETTEXT, 0&, ByVal " " & strPDFPath keybd_event VK_DELETE, 0, 0, 0 'press delete keybd_event VK_DELETE, 0, KEYEVENTF_KEYUP, 0 ' release delete 'Get the PDF file name from the full path. On Error Resume Next PDFName = Mid(strPDFPath, WorksheetFunction.Find("*", WorksheetFunction.Substitute(strPDFPath, "\", "*", Len(strPDFPath) _ - Len(WorksheetFunction.Substitute(strPDFPath, "\", "")))) + 1, Len(strPDFPath)) On Error GoTo 0 'Save/print the web page by pressing the save button of the print window. Sleep 1000 ChildSaveButton = FindWindowEx(Ret, ByVal 0&, "Button", "&Save") SendMessage ChildSaveButton, BM_CLICK, 0, 0 'Sometimes the printing delays, especially in large colorful web pages. 'Here the code checks printer status and if is idle it means that the 'printing has finished. Do Until CheckPrinterStatus("Adobe PDF") = "Idle" DoEvents If CheckPrinterStatus("Adobe PDF") = "Error" Then Exit Do Loop 'Since the Adobe Professional opens after finishing the printing, find 'the open PDF document and close it (using a post message). StartTime = Now() Do Until StartTime > StartTime + TimeValue("00:00:05") PDFRet = 0 DoEvents PDFRet = FindWindow(vbNullString, PDFName & " - Adobe Acrobat") If PDFRet <> 0 Then Exit Do Loop If PDFRet <> 0 Then PostMessage PDFRet, WM_CLOSE, 0&, 0& End If End If End If End If End If End If End If End Sub Function CheckPrinterStatus(strPrinterName As String) As String 'Provided the printer name the functions returns a string 'with the printer status. 'By Christos Samaras 'http://www.myengineeringworld.net Dim strComputer As String Dim objWMIService As Object Dim colInstalledPrinters As Variant Dim objPrinter As Object 'Set the WMI object and the check the install printers. On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer") 'If an error occurs in the previous step, the function will return error. If Err.Number <> 0 Then CheckPrinterStatus = "Error" End If On Error GoTo 0 'The function loops through all installed printers and for the selected printer, 'checks it status. For Each objPrinter In colInstalledPrinters If objPrinter.Name = strPrinterName Then Select Case objPrinter.PrinterStatus Case 1: CheckPrinterStatus = "Other" Case 2: CheckPrinterStatus = "Unknown" Case 3: CheckPrinterStatus = "Idle" Case 4: CheckPrinterStatus = "Printing" Case 5: CheckPrinterStatus = "Warmup" Case 6: CheckPrinterStatus = "Stopped printing" Case 7: CheckPrinterStatus = "Offline" Case Else: CheckPrinterStatus = "Error" End Select End If Next objPrinter 'If there is a blank status the function returns error. If CheckPrinterStatus = "" Then CheckPrinterStatus = "Error" End Function
最后，将这些常量和函数声明为一个模块（可以是与主子（或不同的模块）相同的模块）。
Option Explicit Public Declare Sub Sleep Lib "kernel32" _ (ByVal dwMilliseconds As Long) Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _ (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Public Declare Function SetForegroundWindow Lib "user32" _ (ByVal hWnd As Long) As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public 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 Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Sub keybd_event Lib "user32" _ (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) 'Constants used in API functions. Public Const SW_MAXIMIZE = 3 Public Const WM_SETTEXT = &HC Public Const VK_DELETE = &H2E Public Const KEYEVENTF_KEYUP = &H2 Public Const BM_CLICK = &HF5& Public Const WM_CLOSE As Long = &H10