Constant Loop Issue with Retry Button

[Vagus14]

I'm trying to do the following with the code below:

1. If the file is not in your My Documents folder than goto errhandler and a message box pops up asking you to retry or cancel.
2. When the user clicks retry it goes back and trys again but if the file still isn't there a runtime error 1004 occurs.

I want it to continue to loop when the user presses retry or until cancel is pressed. I've been trying with the code below but no luck. Any suggustions?

Thanks!

Public Function AddITARPicOffloadAnalysis()
    Dim xlApp As Object
    Dim wb As Object
    Dim ws As Object
    Dim Lastrow As Long
    Dim objFolders As Object
    
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
    
    
    On Error GoTo ErrHandler
      Do
        Set objFolders = CreateObject("WScript.Shell").SpecialFolders
        Set wb = .Workbooks.Open(objFolders("mydocuments") & "\OffloadAnalysis.xlsx")
        Set ws = wb.Sheets(1)
        'Code below counts the cells with data and selects the last empty cell
        Lastrow = ws.UsedRange.Rows.Count
        Blankcell = Lastrow + 1
        ws.Cells(Blankcell, "I").Select
        ws.pictures.insert (D:\Sample.png)
        .Visible = True
        LinkToFile = False
        SaveWithDocument = True
        wb.Close , SaveChanges:=True
    Set xlApp = Nothing
Exit Function
ErrHandler:
i = MsgBox("Make sure that OffloadAnalysis.xlsx is in the following location:" & objFolders("mydocuments"), vbRetryCancel, "File Location")
Loop While i = vbRetry
If i = vbCancel Then
End If
End With
End Function

 

[BlueIshDan]

I'm sorry, I cannot follow what you're trying to do here.
Could you please let me know in pseudo code or explain in another way?

 

[pr2-eugin]

I am not sure if you get the concept or you are just asking because you have something else in mind and hoping this is what you need to do. The code you are trying to fix, is simply going to loop when you hit retry, no real problem is going to be solved there !

Public Function AddITARPicOffloadAnalysis()
[COLOR=Red][B]On Error GoTo ErrHandler[/B][/COLOR]
    Dim xlApp As Object, wb As Object
    Dim ws As Object, Lastrow As Long
    Dim objFolders As Object
    
    Set xlApp = CreateObject("Excel.Application")
[COLOR=Red][B]whyTheHell:[/B][/COLOR]
    With xlApp
        Set objFolders = CreateObject("WScript.Shell").SpecialFolders
        Set wb = .Workbooks.Open(objFolders("mydocuments") & "\OffloadAnalysis.xlsx")
        Set ws = wb.Sheets(1)
       [COLOR=Green] 'Code below counts the cells with data and selects the last empty cell[/COLOR]
        Lastrow = ws.UsedRange.Rows.Count
        Blankcell = Lastrow + 1
        ws.Cells(Blankcell, "I").Select
        ws.pictures.insert (D:\Sample.png)
        .Visible = True
        LinkToFile = False
        SaveWithDocument = True
        wb.Close , SaveChanges:=True
    End With
[COLOR=Red][B]exitOnErr:
    Set xlApp = Nothing
    Exit Function
ErrHandler:
    If Err.Number = 1004 Then
        If MsgBox("Make sure that OffloadAnalysis.xlsx is in the following location:" & objFolders("mydocuments"), vbRetryCancel, "File Location") = vbRetry Then _
            Resume whyTheHell
    Else
        Resume exitOnErr
    End If[/B][/COLOR]
End Function

 

[Vagus14]

Hey BlueIshDan sorry for the confusion.

When you press the retry button if the file isn't in the my documents folder the code ends with a runtime error of 1004. I want it to loop through the code and everytime there's an error end up on the messagebox.

 

[BlueIshDan]

You could always just say

      ' Reference: Microsoft Scripting Runtime
    
     Dim fs As New FileSystemObject
     Do While Not fs.FileExists([file_location])
        If MsgBox(msg) = vbCancel Then: Exit Do
     Loop

 

[BlueIshDan]

Hey BlueIshDan sorry for the confusion.

When you press the retry button if the file isn't in the my documents folder the code ends with a runtime error of 1004. I want it to loop through the code and everytime there's an error end up on the messagebox.

U want to search all of the folders within mydocuments? why lol
Anyways if u really do, click the GetSubFolders link below and read lol

 

[BlueIshDan]

I am not sure if you get the concept or you are just asking because you have something else in mind and hoping this is what you need to do. The code you are trying to fix, is simply going to loop when you hit retry, no real problem is going to be solved there !

Public Function AddITARPicOffloadAnalysis()
[COLOR=Red][B]On Error GoTo ErrHandler[/B][/COLOR]
    Dim xlApp As Object, wb As Object
    Dim ws As Object, Lastrow As Long
    Dim objFolders As Object
    
    Set xlApp = CreateObject("Excel.Application")
[COLOR=Red][B]whyTheHell:[/B][/COLOR]
    With xlApp
        Set objFolders = CreateObject("WScript.Shell").SpecialFolders
        Set wb = .Workbooks.Open(objFolders("mydocuments") & "\OffloadAnalysis.xlsx")
        Set ws = wb.Sheets(1)
       [COLOR=Green] 'Code below counts the cells with data and selects the last empty cell[/COLOR]
        Lastrow = ws.UsedRange.Rows.Count
        Blankcell = Lastrow + 1
        ws.Cells(Blankcell, "I").Select
        ws.pictures.insert (D:\Sample.png)
        .Visible = True
        LinkToFile = False
        SaveWithDocument = True
        wb.Close , SaveChanges:=True
    End With
[COLOR=Red][B]exitOnErr:
    Set xlApp = Nothing
    Exit Function
ErrHandler:
    If Err.Number = 1004 Then
        If MsgBox("Make sure that OffloadAnalysis.xlsx is in the following location:" & objFolders("mydocuments"), vbRetryCancel, "File Location") = vbRetry Then _
            Resume whyTheHell
    Else
        Resume exitOnErr
    End If[/B][/COLOR]
End Function

haha Resume whyTheHell!!! love the subtle comment

 

[Vagus14]

I want the message box to pop up if that file "OffloadAnalysis isn't in the 'mydocuments' location and enable the user to retry until they put the file there or just cancel and proceed with the next step and skip.

This worked perfectly. I am new to the error handling thing so I learned a lot from this. Thanks so much for your help!