All, I have the following code and there is one line in it that needs to be changed, but I'm not sure how to fix it without breaking it!!!
The Directory line in green no longer exists. That IShare site has been removed. But the line in Red does exist. So what I need my code to do is check that site on OneDrive and if my file already exists, then it won't let me create another copy. Just like it does for the desktop. Basically the code checked 2 places to see if the file i'm creating already exists and if it did, then the code would error out. So I'm just not sure how to fix the IfDIR line?
Thanks in advance
VBA Code:
Sub CreateA()
On Error GoTo ErrorHandler:
With Application
.EnableEvents = False
.ScreenUpdating = False
.StatusBar = "Creating Amended. Please wait..."
End With
If ActiveWorkbook.Name Like "Initials*" And Left(ActiveSheet.Name, 2) = "AM" Or ActiveWorkbook.Name Like "Initials*" And Left(ActiveSheet.Name, 2) = "PM" Then
If ActiveWorkbook.ReadOnly = True Then MsgBox "The Initials were open as 'Read-Only.' Please open them as NOT 'Read-Only' and try again!", 16, "Initials Read-Only": GoTo Cleanup
myDate = Range("F1").Value
newLine = Chr(10) & Chr(13)
response1 = MsgBox(" Are you sure you want to create the 'Amended' for " & Format(myDate, "mm/dd/yy") & "?" & _
newLine & " If so, the following will occur:" & _
newLine & " - the 'Initials' will be saved" & _
newLine & " - the 'Amended' will be created at a location of your choosing", 292, "Create Amended")
If response1 = 7 Then MsgBox "The user cancelled this process. No 'Amended' was created.", 48, "User Cancelled": GoTo Cleanup
response2 = MsgBox(" Would you like to save the 'Amended' to the 'Amended' folder?" & _
newLine & " - click 'Yes' for the 'Amended' folder" & _
newLine & " - click 'No' to save to your Desktop" & _
newLine & " - click 'Cancel' to cancel this process", 547, "Location")
If response2 = 2 Then MsgBox "The user cancelled this process. No 'Amended' was created.", 48, "User Cancelled": GoTo Cleanup
If ActiveWorkbook.Saved = False Then ActiveWorkbook.Save
[COLOR=rgb(0, 168, 133)] If Dir("\\airport.ishare.tsa.dhs.gov@SSL\DavWWWRoot\fieldlocations\MHT\soc\SOC Scheduling\Shared Documents\Amended\"[/COLOR] & Left(ActiveSheet.Name, 2) & _
" Amended " & Format(myDate, "mm-dd-yy") & ".xlsm") <> "" Or Dir("C:\Users\" & Environ("USERNAME") & "\OneDrive - USTSA\Desktop\" & Left(ActiveSheet.Name, 2) & _
" Amended " & Format(myDate, "mm-dd-yy") & ".xlsm") <> "" Then MsgBox "The 'Amended' already exist in the 'Amended' folder or on your Desktop. " & _
" Please remove and try again. No 'Amended' was created.", 48, "File Already Exist": GoTo Cleanup
Select Case response2
Case 6
ActiveWorkbook.SaveAs[COLOR=rgb(226, 80, 65)] Filename:="https://ustsa.sharepoint.com/sites/Airport-R1-MHT/soc/SOC Scheduling/Shared Documents/Amended/"[/COLOR] & _
Left(ActiveSheet.Name, 2) & " Amended " & Format(myDate, "mm-dd-yy") & ".xlsm", ConflictResolution:=1
Case 7
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ("USERNAME") & "\OneDrive - USTSA\Desktop\" & Left(ActiveSheet.Name, 2) & _
" Amended " & Format(myDate, "mm-dd-yy") & ".xlsm", ConflictResolution:=1
End Select
Application.DisplayAlerts = False
For Each X In ActiveWorkbook.Sheets
If X.Name <> ActiveSheet.Name And X.Name <> "Master Schedule" And X.Name <> "Audit" Then X.Delete
Next X
Range("F1").Value = myDate
If Worksheets("Master Schedule").Visible = True Then Worksheets("Master Schedule").Visible = False
Application.DisplayAlerts = True
ActiveWorkbook.Save
MsgBox "The 'Amended' was successfully created!", 64, "Amended Created"
End If
Cleanup:
With Application
.EnableEvents = True
.StatusBar = ""
End With
Exit Sub
ErrorHandler:
MsgBox "Error number '" & Err.Number & "' has occurred:" & newLine & newLine & _
Err.Description & newLine & newLine & _
"Please try again. If the error persists, please contact Patrick Dunn for assistance.", 16, "Error Occurred"
GoTo Cleanup
End Sub
The Directory line in green no longer exists. That IShare site has been removed. But the line in Red does exist. So what I need my code to do is check that site on OneDrive and if my file already exists, then it won't let me create another copy. Just like it does for the desktop. Basically the code checked 2 places to see if the file i'm creating already exists and if it did, then the code would error out. So I'm just not sure how to fix the IfDIR line?
Thanks in advance