Build multi-stage macro

[quick_question]

Hey All,

I had a macro that I've since lost due to a bad hard drive that was an efficient combination of a couple different macros and need a bit of help rebuilding.

What I'm trying to do is:
A) Save Sheet1 as pdf (I already have a predetermined print area)
B) Check if folder exists - if not (which it shouldn't unless the reports are re-run for some reason) create a folder based on the week the report was drafted (i.e. "Wk28" Wk# will be located in cell G5). The file location specified as a general location (i.e. C:\users\John\Sales\) then within the folder that was just created (i.e. C:\users\John\Sales\Wk28).
D) Define the FileName as the "District_Date".pdf. Region = cell B4. Date = cell G4
D) Save Sheet1 in this location as a pdf

Thanks for your help!

 

[HotRhodium]

Ill help get you started. This is cut out of one of my projects please change the file path to what you need. This will perform step B

Public Sub Demo()
Dim MyFilePath As String
MyFilePath = "Put file path here"
 If MakeFilePathBool Then
  'File path either already exists or was made
 Else
  'Error making file path
 End If
End Sub

Public Function MakeFilePathBool(StartString As String) As Boolean
Dim objDrv As Object
Dim MyString As String, DriLet As String, PathTempString As String
Dim PassBool As Boolean
Dim BSPos As Integer, BSCount As Integer
Dim i As Integer, j As Integer
 On Error GoTo ErrorMGMT
 DriLet = Left(StartString, 2)
 PassBool = False
 j = 1
 For Each objDrv In CreateObject("Scripting.FileSystemObject").Drives
  If DriLet = objDrv Then
   PassBool = True
   GoTo 1
  End If
 Next objDrv
1
 If Not PassBool Then
  MsgBox ("Drive " & DriLet & " not found")
  'Log as error should not be able to enter an invalid drive letter!!!
  GoTo ErrorMGMT
 End If
 MyString = Replace(StartString, "\", "")
 BSCount = Len(StartString) - Len(MyString)
 For i = 1 To BSCount
  BSPos = InStr(j, StartString, "\")
  j = BSPos + 1
  PathTempString = Left(StartString, BSPos - 1)
  If Dir(PathTempString, vbDirectory) = "" Then
   MkDir (PathTempString)
  End If
 Next i
 PathTempString = StartString
 If Dir(PathTempString, vbDirectory) = "" Then
  MkDir (PathTempString)
 End If
 MakeFilePathBool = True
GoTo 9
ErrorMGMT:
MakeFilePathBool = False
9
End Function

 

[quick_question]

HotRhodium,

Thanks for your help! Got to be honest - I'm new to working with macros. Would you be able to briefly explain what each part of you macro is responsible for doing?

Thanks again - huge help!

 

[HotRhodium]

Public Function MakeFilePathBool(StartString As String) As Boolean
Dim objDrv As Object
Dim MyString As String, DriLet As String, PathTempString As String
Dim PassBool As Boolean
Dim BSPos As Integer, BSCount As Integer
Dim i As Integer, j As Integer
 On Error GoTo ErrorMGMT ' makes path to exit on error
 DriLet = Left(StartString, 2) 'The Drive letter should be the left most 2 characters in a string for example C:
 PassBool = False 'Initializes Bool value to False
 j = 1 'Initializes j to 1
 For Each objDrv In CreateObject("Scripting.FileSystemObject").Drives 'Cycles through each drive letter
  If DriLet = objDrv Then 'If the drove letter cycling matches drive letter passed set to true
   PassBool = True
   GoTo 1 'Skip remaining drives
  End If
 Next objDrv
1
 If Not PassBool Then 'Check if drive letter failed first check
  MsgBox ("Drive " & DriLet & " not found") 'on fail bring up a message box explaining problem
  GoTo ErrorMGMT 'This path to error exiting the function will return False
 End If
 MyString = Replace(StartString, "\", "") 'Removes all "\"
 BSCount = Len(StartString) - Len(MyString) 'Counts the difference to determine the number of files that will be needed
 For i = 1 To BSCount 'Cycles for each folder
  BSPos = InStr(j, StartString, "\")
  j = BSPos + 1
  PathTempString = Left(StartString, BSPos - 1) 'Sets a temporary path to check (C:\Users\Default is converted to C:\Users for the first loop)
  If Dir(PathTempString, vbDirectory) = "" Then 'If the file does not exist
   MkDir (PathTempString) 'Makes file path on error sets function to false and exits
  End If
 Next i
 PathTempString = StartString 'Sets the path to the final path
 If Dir(PathTempString, vbDirectory) = "" Then 'If the file does not exist
  MkDir (PathTempString) 'Makes file path on error sets function to false and exits
 End If
 MakeFilePathBool = True 'Sets function to true
GoTo 9 'Skips to end of function
ErrorMGMT:
MakeFilePathBool = False 'Error found in function permissions error or invalid file path etc sets function to False
9
End Function