VBA是否将网页从Excel工作簿打印为PDF？

我有一个Excel工作簿，代码如下。它的设计目的是导航到google.co.uk并以PDF格式打印网页

这几乎可以正常工作。代码导航到网页并打印为PDF，然后打开PDF文档

但是，我似乎在设置文件保存位置时遇到问题

我希望我的PDF文件始终保存在此位置：

G:\QUALITY ASSURANCE\06_SUPPLIER INFORMATION

但出于某种原因，它总是保存到桌面上。应该有一个“另存为”对话框打开，但从未显示

我从一个网站上复制了这段代码，试图让我开始学习，这样我就不会假装完全理解了。我对VBA很陌生

基本上，我的目标是让网页自动打印成PDF格式，并保存在正确的文件夹中，而无需用户提示保存对话框或点击保存

我也不希望PDF在保存后打开

这是我的密码。如何让我的代码执行我需要的操作

代码

选项显式
公共声明子睡眠库“内核32”_
（ByVal的长度为毫秒）
公共声明函数findwindowlib“user32”别名“FindWindowA”_
（ByVal lpClassName作为字符串，ByVal lpWindowName作为字符串）长度相同
公共声明函数FindWindowEx Lib“user32”别名“FindWindowExA”_
（ByVal hWnd1为长，ByVal hWnd2为长，ByVal lpsz1为字符串，ByVal lpsz2为字符串）为长
公共声明函数SetForegroundWindow Lib“user32”_
（ByVal hWnd As Long）一样长
公共声明函数SendMessage Lib“user32”别名“SendMessageA”_
（ByVal hWnd为长，ByVal wMsg为长，ByVal wParam为长，lParam为任何）为长
公共声明函数SendMessageByString Lib“user32”别名“SendMessageA”_
（ByVal hWnd为长，ByVal wMsg为长，ByVal wParam为长，ByVal lParam为字符串）为长
公共声明函数PostMessage Lib“user32”别名“PostMessageA”_
（ByVal hWnd为长，ByVal wMsg为长，ByVal wParam为长，lParam为任何）为长
公共声明子keybd_事件库“user32”_
（ByVal bVk作为字节，ByVal bScan作为字节，ByVal dwFlags作为长，ByVal dwExtraInfo作为长）
'API函数中使用的常量。
公用工程SW_最大化=3
公共常量WM_SETTEXT=&HC
公共常量VK_DELETE=&H2E
Public Const keyevent fu KEYUP=&H2
公用工程BM_点击=&HF5&
公共Const WM_CLOSE As Long=&H10
子宏（）
Application.DisplayAlerts=False
Application.ScreenUpdating=False
'将默认打印机设置为AdobePDF
将WSHnet作为对象
Dim dteStartTime作为日期
设置WSHNetwork=CreateObject（“WScript.Network”）
WSHNetwork.SetDefaultPrinter“Adobe PDF”
'从单元格范围获取pdfSave as路径
作为字符串的Dim-sFolder
sFolder=Sheets（“Sheet1”）。范围（“A1”）假定文件夹另存为路径位于mySheets的单元格A1中
模糊的物体
作为字符串的Dim Webloc
将FullWeb设置为字符串
全文=”https://www.google.com"
'设置IE=CreateObject（“InternetExplorer.Application”）
设置IE=新的InternetExplorerMedium
'IE.Visible=True
浏览全文
dteStartTime=现在
在IE.READYSTATE READYSTATE\u完成时执行此操作
如果DateDiff（“s”，dteStartTime，Now）>240，则退出Sub
环
IE.ExecWB 6，2'OLECMDID_打印，OLECMDEXECOPT_dont打印机
Application.Wait DateAdd（“s”，1，Now）
调用PDFPrint2（范围（“B”和ActiveCell.Row）.Value&“BRC”&Replace（范围（“K”和ActiveCell.Row）.Value“/”，“）&“pdf”）
即退出
设置IE=无
Application.DisplayAlerts=True
Application.ScreenUpdating=True
端接头
子PDFPrint2（STRPDFPPATH作为字符串）
'使用Adobe Professional将网页打印为PDF文件。
'API函数用于指定必要的窗口
'WMI函数用于检查打印机的状态。
”“克里斯托斯·萨马拉斯
'http://www.myengineeringworld.net
暗色尽可能长
迟钝的孩子
暗淡的孩子2一样长
暗淡的孩子3一样长
暗淡的组合像长的一样
暗淡的编辑
将ChildSave按钮变暗为长
模糊PDFRet与长PDFRet一样
Dim PDFName作为字符串
暗淡的开始时间为日期
暗淡的AcroApp
'打开Acrobat并最小化
设置AcroApp=CreateObject（“AcroExch.App”）
strPDFPath=“G:\QUALITY ASSURANCE\06\u供应商信息”
'查找主打印窗口。
StartTime=Now（）
直到现在为止（）>开始时间+时间值（“00:00:00”）
Ret=0
多芬特
Ret=FindWindow（vbNullString，“将PDF文件另存为”）
如果Ret为0，则退出Do
环
如果Ret为0，则
SetForegroundWindow（Ret）
'查找第一个子窗口。
StartTime=Now（）
直到现在为止（）>开始时间+时间值（“00:00:00”）
ChildRet=0
多芬特
ChildRet=FindWindowEx（Ret，ByVal 0&，“DUIViewWndClassName”，vbNullString）
如果ChildRet为0，则退出Do
环
如果ChildRet为0，则
'查找第二个子窗口。
StartTime=Now（）
直到现在为止（）>开始时间+时间值（“00:00:00”）
ChildRet2=0
多芬特
ChildRet2=FindWindowEx（ChildRet，ByVal 0&，“DirectUIHWND”，vbNullString）
如果ChildRet2为0，则退出Do
环
如果ChildRet2 0那么
'查找第三个子窗口。
StartTime=Now（）
直到现在为止（）>开始时间+时间值（“00:00:00”）
ChildRet3=0
多芬特
ChildRet3=FindWindowEx（ChildRet2，ByVal 0&，“FloatNotifySink”，vbNullString）
如果ChildRet3为0，则退出Do
环
如果孩子30那么
'查找将要编辑的组合框。
StartTime=Now（）
直到现在为止（）>开始时间+时间值（“00:00:00”）
comboRet=0
多芬
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

Sub WebSMacro()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'set default printer to AdobePDF
Dim WSHNetwork As Object
Dim dteStartTime As Date
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

FullWeb = "https://www.google.com"

'Set IE = CreateObject("InternetExplorer.Application")
Set IE = New InternetExplorerMedium


    'IE.Visible = True
    IE.navigate FullWeb

    dteStartTime = Now
   Do While IE.READYSTATE <> READYSTATE_COMPLETE
      If DateDiff("s", dteStartTime, Now) > 240 Then Exit Sub
   Loop

    IE.ExecWB 6, 2 'OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER
    Application.Wait DateAdd("s", 1, Now)
    Call PDFPrint2(Range("B" & ActiveCell.Row).Value & "_BRC_" & Replace(Range("K" & ActiveCell.Row).Value, "/", ".") & "_" & ".pdf")

    IE.Quit



Set IE = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub PDFPrint2(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
    Dim AcroApp


'open Acrobat and minimize
Set AcroApp = CreateObject("AcroExch.App")

    strPDFPath = "G:\QUALITY ASSURANCE\06_SUPPLIER INFORMATION\"

    'Find the main print window.
    StartTime = Now()
    Do Until Now() > StartTime + TimeValue("00:00:00")
        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:00")
            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:00")
                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:00")
                    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:00")
                        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:00")
                            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 = "test"
                            On Error GoTo 0

                            'Save/print the web page by pressing the save button of the print window.
                            Sleep 0
                            ChildSaveButton = FindWindowEx(Ret, ByVal 0&, "Button", "&Save")
                            SendMessage ChildSaveButton, BM_CLICK, 0, 0


                        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