Check dir, create dir, save as

[Russmeister57]

Hi all,

I need a bit of help again.

Could you take a look at the below code, i'm not quite sure where ive gone wrong. I know it's just a case of putting the correct code in the correct place but each time i get the same issue.
This code should check directory for folder, if its not there then create it, once created, save the userform based of the values in the textboxes from a sheet in excel. Now forcing landscape in said folder, but if the file already exists in the path then to tell the user that it does so as not to make a copy or overwrite. I keep getting it telling me that it already exists yet it doesnt.

I have this code at the top too:

Option Explicit
Private Declare PtrSafe Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, ByVal bScan As Byte, _
     ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1

Private Sub CommandButton3_Click()
Dim Path As String
Dim Shift As String
Dim TM As String
Dim Col As String
Dim Tot As String
Dim Week As String

Path = "I:\My Path\"
Shift = Sheet8.Range("Y8")
TM = Sheet8.Range("Z8")
Col = Sheet8.Range("X8")
Week = Individual_Performance.TextBox5.Value
On Error GoTo ErrHandler
Tot = Path & "Completed Reviews" & "\" & Shift & "\" & TM & "\" & Col & "\" & Col & " Week " & Week
If Dir(Path & "Completed Reviews" & "\" & Shift & "\" & TM & "\" & Col & "\", vbDirectory) = "" Then
        MkDir Path & "Completed Reviews" & "\" & Shift & "\" & TM & "\" & Col & "\"

End If
DoEvents
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + _
        KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + _
        KEYEVENTF_KEYUP, 0
    DoEvents
    Workbooks.Add
    Application.Wait Now + TimeValue("00:00:01")
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, _
        DisplayAsIcon:=False
    ActiveSheet.Range("A1").Select
    'added to force landscape
    ActiveSheet.PageSetup.Orientation = xlLandscape

If Tot = False Then
    ActiveSheet.SaveAs Filename:=Tot
    MsgBox "Review For " & Col & " Complete"
    Else: MsgBox "Review For " & Col & " Has Already Been Completed", vbExclamation, "File Exists"
Exit Sub
End If
ActiveWindow.Close SaveChanges:=False
Unload Individual_Performance
ErrHandler:
    MsgBox "Review For " & Col & " Has Already Been Completed", vbExclamation, "File Exists"
   
Unload Individual_Performance
End Sub

 

[sijpie]

Look at the end of your code, and read my comments

If Tot = False Then
    ActiveSheet.SaveAs Filename:=Tot
    MsgBox "Review For " & Col & " Complete"
Else 
    MsgBox "Review For " & Col & " Has Already Been Completed", vbExclamation, "File Exists" '<<<< If this runs then Tot =True
    Exit Sub         '<<<<< and the sub ends
End If
'<<<< if the file didn't exist it does now and the code continues here
ActiveWindow.Close SaveChanges:=False
Unload Individual_Performance
'<<<< The activesheet has been closed, and the userform has been closed
'<<<< Now the code comes to the next line which is run
ErrHandler:
    MsgBox "Review For " & Col & " Has Already Been Completed", vbExclamation, "File Exists"
'<<<< So you will see the message box anyway!!! You can check by modifying the text, that it is this messagebox you are seeing, not the previous   
Unload Individual_Performance
End Sub

To not run the ErrHandler when things go OK, put an Exit Sub in the line above it