VBAでウェブサイトをPDF保存する方法

投稿者 : あほです     投稿日時 : 2023/03/31(Fri) 19:35:13     OS : 未指定     EXCEL : 未指定

---

VBAを使い下記を実行したいのですがうまく行きません。
特に保存のところで指定フォルダが開かなかったり、ファイル名が入力されないと言った現象が起きます。
尚、セキュリティの問題もあり何か追加でダウンロード、インストールしたりすることができない環境です。

プログラミング、VBAも含め初心者なもので意図が伝わるか不安ですがご回答お願い致します。


①IEで’ウェブサイト’を開く
②nameに、セルDの4を入力し、nameをクリック
③②の処理後表示されたページをPDFで指定のフォルダに保存する。保存先は「指定フォルダ」、保存ファイル名は②で入力したセルD4の右セルE4を指定
④保存の際、すでに同名ファイルが存在していた場合は既存ファイルを削除して保存、存在しなければそのまま保存
⑤①～④の処理を、D列が空白になるまで繰り返す


SubSave_Webpage_As_PDF()

    ' Create InternetExplorer object
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    
    ' Set worksheet object
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' Get last row of data in column D
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    
    ' Loop through each row of data starting from row 4
    Dim i As Long
    For i = 4 To lastRow
    
        ' Check if column D is not empty
        If ws.Range("D" & i).Value <> "" Then
        
            ' Set file name from column E and create file path
            Dim fileName As String
            fileName = ws.Range("E" & i - 1).Value ' Use the value from column E in the previous row
            
            ' Add ".pdf" extension if necessary
            If Right(fileName, 4) <> ".pdf" Then
                fileName = fileName & ".pdf"
            End If
            
            Dim objFSO As Object
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Dim folderPath As String
            folderPath = "フォルダ名"
            Dim fullFilePath As String
            fullFilePath = folderPath & fileName
            
            ' Check if file already exists
            If objFSO.FileExists(fullFilePath) Then ' If file already exists, delete it
                objFSO.DeleteFile fullFilePath
            End If
            
            ' Navigate to webpage
            IE.navigate "ウェブサイトURL"
            
            ' Wait until webpage is loaded
            Do While IE.readyState <> 4 Or IE.Busy
                DoEvents
            Loop
            
            ' Get the text box element and enter the value from column D
            Dim txtBox As Object
            Set txtBox = IE.document.getElementsByName("name")(0)
            
            Dim cellValue As String
            cellValue = ws.Range("D" & i).Value
            txtBox.Value = cellValue
            
            ' Click the search button
            Dim btn As Object
            Set btn = IE.document.getElementsByName("name")(0)
            btn.Click
            
            ' Wait until search results are loaded
            Do While IE.readyState <> 4 Or IE.Busy
                DoEvents
            Loop
            
            ' Set printer to "Microsoft Print to PDF"
            Dim originalPrinter As String
            originalPrinter = Application.ActivePrinter
            Application.ActivePrinter = "Microsoft Print to PDF"
            
            ' Print webpage as PDF and save to file path
            Dim tempFilePath As String
            tempFilePath = Environ$("temp") & "\" & fileName ' Create temporary file path
            IE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, 0, True ' Print as PDF and show "Save As" dialog
            objFSO.MoveFile tempFilePath, fullFilePath ' Move temporary file to specified file path
            
            ' Reset printer to original printer
            Application.ActivePrinter = originalPrinter
            
        End If
    Next i
    
    ' Close InternetExplorer object
    IE.Quit

End Sub

投稿者 : ヘンリー     投稿日時 : 2023/04/03(Mon) 11:05:09

---

>尚、セキュリティの問題もあり何か追加でダウンロード、インストールしたりすることができない環境です。
IEは2022年6月16日にサポートが終了しています。
セキュリティの問題があるなら、IEを使う事をやめた方が良いと思います。