I am testing my DB in runtime mode and am having problems with the code below. The code will execute and do what it is supposed to do which is check directories, rename a file and copy the file to another directory. But after it does all that, I get an error: "Execution of this application has stopped due to a run-time error", "The application can't continue and will be shut down." And shut down it does.
I have tried several times to remove what seems to be excessive code, but nothing seems to work which will still allow the code to execute and not cause debugging issues . With all my trials and error in piecing together the code, I've ended up with the code below that is not very pretty, but works in my normal db mode. I am hoping someone can spot obvious problems and an early exit point .
Code:
Private Sub cmdFileNameSend_Click()
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogOpen)
'Declare a variable to contain the path
'of each selected item. Even though the path is aString,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim OrigPath As Variant
Dim OP As Variant
Dim NNPath As Variant
Dim NFPath As Variant
'Use a With...End With block to reference the FileDialog object.
With fd
'Use the Show method to display the File Picker dialog box and return the user's action.
'The user pressed the button.
'If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
'For Each vrtSelectedItem In .SelectedItems
If fd.Show = True Then
For Each OrigPath In fd.SelectedItems
'NNPath= Original Path + New Name + the extension
NNPath = Left(OrigPath, InStrRev(OrigPath, "\")) & NewName & Mid(OrigPath, InStrRev(OrigPath, "."))
'NFPath = New Path + New Name + the Extension
NFPath = FullPath & "\" & NewName & Mid(NNPath, InStrRev(NNPath, "."))
'Notes:
' NewName & Mid(OrigPath, InStrRev(OrigPath, ".")) = New file name + Original Extension
'Mid([OrigPath], InStrRev([OrigPath], "\") + 1) = Original Name + Original Extension
'MsgBox Left([NFPath], InStrRev([NFPath], "\") - 1)
'Check if file exists
If Dir(NNPath) <> "" Then
If MsgBox("Send File?" & vbCrLf & Mid([OrigPath], InStrRev([OrigPath], "\") + 1) & vbCrLf & "To: Sessions Folder", vbYesNo, "Send File") = vbYes Then
FileCopy OrigPath, FullPath & "\" & Mid([OrigPath], InStrRev([OrigPath], "\") + 1)
MsgBox "Your File Has been sent", vbOK
End
End If
' MsgBox "File: " & NewName & Mid(OrigPath, InStrRev(OrigPath, ".")) & " Already Exists!!! Please check Your Files"
Else
'MsgBox "No Go!"
'End ' I added this so it will go no further
'End If
'Rename Msg
If MsgBox("Rename: " & Mid([OrigPath], InStrRev([OrigPath], "\") + 1) & _
vbCrLf & "As: " & NewName & Mid(OrigPath, InStrRev(OrigPath, ".")), vbYesNo + vbQuestion, "Accept or Cancel") = vbYes Then
'Rename Orininal file Name
Name OrigPath As NNPath
'MsgBox NFPath
'Confirm Send File
If MsgBox("Send File: " & Mid([NNPath], InStrRev([NNPath], "\") + 1) & _
vbCrLf & vbCrLf & "" & "To: Sessions Folder ", vbYesNo + vbQuestion, "Send File") = vbYes Then
'Copy file with new name to Destination Folder
FileCopy NNPath, NFPath
MsgBox "File Successfully Sent! "
End
End If
End
End
End If
End If
End
'Else
Next
' Next
End If
'vrtSelectedItem is a string that contains the path of each selected item.
'You can use any file I/O functions that you want to work with this path.
'This example displays the path in a message box.
' Next vrtSelectedItem
'The user pressed Cancel.
'Else
'End If
End With
'Set the object variable to nothing.
Set fd = Nothing
End Sub