When I go through the loop process to find all the files in the completed folder. It says the completed folder is missing a file for district 47, would you like to continue the consolidating approval files" Yes or No
Code:
Function CheckDMApprovals()
DateXVar = InputBox("Enter Request Date: (Should be last Friday, " & Format(Date - 1 - Format(Date, "w"), "m/d") & ")")
DateXVar = DateXVar + 7 - Format(DateXVar, "w")
If IsDate(DateXVar) = False Or IsNull(DateXVar) = True Then
MsgBox "Cancelled"
End
End If
FolderVar = "G:\Teams and Projects\DSM Approval-Store Supply Orders\" & Format(DateXVar, "mm-dd-yy")
strfile = dir("G:\Teams and Projects\DSM Approval-Store Supply Orders\" & Format(DateXVar, "mm-dd-yy") & "\District_??_??-??-??.xlsx") ' - telling process which type of file names to look for ("?" is a wild card character)
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE [DM-ApprovalFiles].* FROM [DM-ApprovalFiles];"
DoCmd.SetWarnings True
'** Begin the loop process.
Do While Len(strfile) > 0 ' - Len() returns the number of characters in "strfile". As long as it finds a file, this will be >0
If FileOrDirExists(FolderVar & "\COMPLETED\" & strfile) = False Then
AnswerVar = MsgBox("The 'Completed' folder is missing a file for district " & Mid(strfile, 10, 2) & vbNewLine & "Would you like to continue consolidating approval files?", 4, "MISSING " & Mid(strfile, 10, 2))
If AnswerVar <> 6 Then
MsgBox "Approval file consolidation ended."
End
Else
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE ReqLists INNER JOIN DistrictTable ON ReqLists.Store = DistrictTable.Store SET ReqLists.[AllowedQty-DM] = IIf([ReqLists]![AllowedQty-DM] Is Null,0,[ReqLists]![AllowedQty-DM]), ReqLists.[AllowedQty-StoreOps] = IIf([ReqLists]![AllowedQty-StoreOps] Is Null,0,[ReqLists]![AllowedQty-StoreOps]) WHERE (((ReqLists.Date)=#" & DateXVar - 1 & "#) AND ((DistrictTable.District)=" & Mid(strfile, 10, 2) & "));"
DoCmd.SetWarnings True
End If
Else
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO [DM-ApprovalFiles] ( FileName, District ) SELECT '" & FolderVar & "\COMPLETED\" & strfile & "' AS Expr1, " & Mid(strfile, 10, 2) & " As Expr2;"
DoCmd.SetWarnings True
End If
strfile = dir
' - resets the "strfile" to the next file in the folder, if there is one
Loop ' - restart loop.
x = Shell("C:\Program Files\Microsoft Office\Office14\EXCEL.EXE K:\Departments\Shipping\Eric\StoreSupplyProject\ApprovalFiles\StoreOpsApproved.xlsm", vbMaximizedFocus)
End Function
Function FileOrDirExists(PathName As String) As Boolean
'Macro Purpose: Function returns TRUE if the specified file
' or folder exists, false if not.
'PathName : Supports Windows mapped drives or UNC
' : Supports Macintosh paths
'File usage : Provide full file path and extension
'Folder usage : Provide full folder path
' Accepts with/without trailing "\" (Windows)
' Accepts with/without trailing ":" (Macintosh)
Dim iTemp As Integer
'Ignore errors to allow for error evaluation
On Error Resume Next
iTemp = GetAttr(PathName)
'Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
'Resume error checking
On Error GoTo 0
End Function
This is the specific code where it crashed,
Code:
If FileOrDirExists(FolderVar & "\COMPLETED\" & strfile) = False Then
AnswerVar = MsgBox("The 'Completed' folder is missing a file for district " & Mid(strfile, 10, 2) & vbNewLine & "Would you like to continue consolidating approval files?", 4, "MISSING " & Mid(strfile, 10, 2))
If AnswerVar <> 6 Then
MsgBox "Approval file consolidation ended."
End
Else
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE ReqLists INNER JOIN DistrictTable ON ReqLists.Store = DistrictTable.Store SET ReqLists.[AllowedQty-DM] = IIf([ReqLists]![AllowedQty-DM] Is Null,0,[ReqLists]![AllowedQty-DM]), ReqLists.[AllowedQty-StoreOps] = IIf([ReqLists]![AllowedQty-StoreOps] Is Null,0,[ReqLists]![AllowedQty-StoreOps]) WHERE (((ReqLists.Date)=#" & DateXVar - 1 & "#) AND ((DistrictTable.District)=" & Mid(strfile, 10, 2) & "));"
DoCmd.SetWarnings True
End If
Else
This is the file that is giving me fits
District_47_10-10-16 .xlsx