0

I have recently written some code for the company I work at in VBA for Excel. The purpose of the code is to run through a list of entered part numbers on Excel, search their respective URL, and then save that webpage as a PDF to the selected folder.

I wrote this code using some inspiration and code from other projects I have seen and also had to add some of my own.

My problem is this:
The code I put here works flawlessly on my computer. I have test ran it many times with many different numbers and it works as intended every time. That being said, I sent this to my adviser via email for him to use because I was making this Excel project for him.

When he opened it on the day I sent it, it worked perfectly for him as it had for me. The next day he tried to run it and started getting automation errors I had never seen like

run-time error '430'

and a few other similar errors.

Does anyone have any idea why the program would work one day and not the next and/or if there is a solution to it?

I'm mainly confused why it would suddenly stop working for him (it does still run perfectly on my computer). Also, for the code below it does follow a real link I just change website parts to "url" for the sake of company privacy.

Although, I don't think that matters anyways because I believe the code is following the first link properly and then has errors when it has to loop through more than one part number.

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Function DownloadFile(URL As String, LocalFilename As String) As Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function

Sub DownloadItemPDF()
    Dim strPDFLink As String
    Dim strPDFFile As String
    Dim doc, hcol, text As Variant
    Dim itemNum As Long
    Dim count As Integer
    Dim i As Long
    Dim URL As String
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object

    Set IE = CreateObject("InternetExplorer.Application")         
    IE.Visible = False

    MsgBox "Select Folder to Save .pdf to"
    Dim FolderName As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show

        On Error Resume Next
        strDir = .SelectedItems(1)
        Err.clear
        On Error GoTo 0
    End With

    ActiveSheet.Range("H3").Select

    For count = 1 To 15
        If Not Selection.Value = "" Then        
            itemNum = Selection.Value
            strPDFLink = "url" & itemNum & "url"
            strPDFFile = strDir & "/Drawing2D_" & itemNum & "_" & Format(Now, "yyyy.mm.dd") & ".pdf"
            IE.Navigate strPDFLink
            Do While IE.ReadyState = 4: DoEvents: Loop
            Do Until IE.ReadyState = 4: DoEvents: Loop
            Application.Wait (Now + #12:00:02 AM#)
            Result = DownloadFile(strPDFLink, strPDFFile)
        End If

        Selection.Offset(1, 0).Select
    Next count
End Sub
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Misc128
  • 3
  • 2
  • 1
    Note that we need an exact error message and the line in which the error occurs to be able to help you properly. Note that `On Error Resume Next` hides all error messages until `On Error GoTo 0` therefore if an error occurs in between you will never notice that means if `strDir = .SelectedItems(1)` fails your code will continue with `strDir` beeing empty for example. • Also get rid of all `.Select`, `Selection` and `ActiveSheet` statements, therfore read: [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). – Pᴇʜ Aug 07 '19 at 13:00
  • @Pᴇʜ These are two of the errors he got: Run-time error '430': Class does not support Automation or does not support expected interface Run-time error '-2147417848 (80010108)': Automation error The object invoked has disconnected from its clients. Also, I know .Select probably isn't the most efficient method of running through numbers, but that part of the code is working for him. – Misc128 Aug 07 '19 at 13:12
  • In which line do the errors occur? – Pᴇʜ Aug 07 '19 at 13:12
  • @Pᴇʜ He gets the errors on the DO UNTIL line in the if statement. – Misc128 Aug 07 '19 at 13:15

1 Answers1

0

Try the following code. I re-organized it and made it more stable. Also I included an error handling to prevent any hidden IE processes in the background.

Public Sub DownloadItemPDF()
    MsgBox "Select Folder to Save .pdf to"

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show

        On Error Resume Next 'hide all error messages
        Dim strDir As String
        strDir = .SelectedItems(1)
        'check if an error occured and exit sub if something went wrong otherwise yo u end up with an empty strDir 
        If Err.Number <> 0 Then
            MsgBox "No valid folder was picked.", vbCritical
            Exit Sub
        End If
        On Error GoTo 0
    End With

    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet 'better define a concrete sheet: ThisWorkbook.Worksheets("SheetName")
                                      'because ActiveSheet might be the wrong one!

    Dim CheckRange As Range
    Set CheckRange = ws.Range("H3").Resize(RowSize:=15)

    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False

    On Error GoTo QUIT_IE 'if an error occurs make sure the invisible IE gets closed

    Dim Cell As Range
    For Each Cell In CheckRange
        If Not Cell.Value = vbNullString Then
            Dim itemNum As Long
            itemNum = Cell.Value

            Dim strPDFLink As String
            strPDFLink = "url" & itemNum & "url"

            Dim strPDFFile As String
            strPDFFile = strDir & "/Drawing2D_" & itemNum & "_" & Format$(Now, "yyyy.mm.dd") & ".pdf"

            IE.navigate strPDFLink
            Do While IE.readyState <> 4 Or IE.Busy: DoEvents: Loop

            Application.Wait (Now + #12:00:02 AM#)
            Dim Result As Boolean
            Result = DownloadFile(strPDFLink, strPDFFile)
        End If
    Next Cell

QUIT_IE:
    IE.Quit 'don't forget to quit IE in case of error otherwise it will stay open invisible
    Set IE = Nothing
    If Err.Number <> 0 Then
        MsgBox "Error occured while trying to load:" & vbCrLf & strPDFLink & vbCrLf & "To:" & vbCrLf & strPDFFile
        Debug.Print "strPDFLink:", strPDFLink
        Debug.Print "strPDFFile:", strPDFFile
        Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Sub
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • Thanks for doing that! I tested it on my computer and it works well. I'm just awaiting the response from my adviser to see if it fixed his problems. Thanks for all the help! – Misc128 Aug 07 '19 at 13:56