run time error 91 problem

**stevesunfold** · 10-21-2008, 01:04 PM

hi gents
just a small issue

i have this fantastic piece of code by protonleah which works

Sub COPYandPRINT()
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=False
     
     PORow = PONUMBER.Value + 1
     
     Sheets("PURCHASE ORDER NUMBERS").Range("A" & PORow).Value = PONUMBER
     Sheets("PURCHASE ORDER NUMBERS").Range("B" & PORow).Value = SUPPLIER
     Sheets("PURCHASE ORDER NUMBERS").Range("C" & PORow).Value = xDATE
     Sheets("PURCHASE ORDER NUMBERS").Range("D" & PORow).Value = JOBNUMBER
     Sheets("PURCHASE ORDER NUMBERS").Range("E" & PORow).Value = CUSTOMERNAME
     Sheets("PURCHASE ORDER NUMBERS").Range("F" & PORow).Value = DESCRIPTION
     Sheets("purchase order").Select
     
     Range("B16:F19,K17:L20,B23:C24,G23:H24,I23:K24,B28:L57").Select
     Range("B16").Activate
     Selection.ClearContents
     Application.ScreenUpdating = True
     PONUMBER = PONUMBER + 1
     Range("B16").Select
     Application.DisplayAlerts = False
End Sub

this works perfectly

i then try to add my save to specific folder code and i get an error

Sub SaveJobFile()
'declare all variables
Dim stOfPath As String
Dim ActualMidFolder As String
Dim EndOfNameAndPath As String
Dim FileNameToSave As String
Dim JobNum As String
Dim PONum As String
Dim SuppliersName As String

'define initial variables (note: the ranges may need to be changed
    JobNum = Range("G23").Value
    PONum = Range("k12").Value
    SuppliersName = Range("b16")
    EndOfNameAndPath = SuppliersName & " Purchase Order " & PONum & Format(Date, " dd.mm.yy") & ".xls"

'test to see if it is stock or PO (?) & define the saving path accordingly
    Select Case UCase(Left(JobNum, 1)) = "J"
        Case True
'Rob's test path:     stOfPath = "C:\Documents and Settings\HP_Owner\My Documents\"
            stOfPath = Range("B69") & "\"
            'test for any likely folders
                If Not (DoesFileFolderExist(stOfPath & JobNum & "*")) Then GoTo TheEnd
            'identify the exact folder
                ActualMidFolder = GetActualFolderName(stOfPath, JobNum) & "\"
            'define rest of file name
                EndOfNameAndPath = "Docs\" & EndOfNameAndPath
                FileNameToSave = stOfPath & ActualMidFolder & EndOfNameAndPath
        Case False
            stOfPath = Range("B70") & "\"
            If Not (DoesFileFolderExist(stOfPath)) Then GoTo TheEnd
                FileNameToSave = stOfPath & EndOfNameAndPath
    End Select

'save the file & finish macro
    ActiveWorkbook.SaveAs Filename:=FileNameToSave
    Exit Sub

TheEnd:
'warn nothing exists & end the macro
    MsgBox "Macro ending b/c no Folder with the following number exists : " & stOfPath & JobNum & "*", , "FYI"
    Debug.Print stOfPath & JobNum & "*"
End Sub

Public Function DoesFileFolderExist(strfullpath As String) As Boolean
'sourced from www.excelguru.ca/node/30 by Ken Puls
'note it only checks for the existence of the lowest folder (or the file) in the strfullpath string.
If Not Dir(strfullpath, vbDirectory) = vbNullString Then DoesFileFolderExist = True
End Function

Function GetActualFolderName(StartOfPath As String, StartOfFuzzyFolder As String)
'sourced & modified from http://www.themssforum.com/ExcelProgramming/parent-folder/
Dim oFSO As Object
Dim SubDirectory
Set oFSO = CreateObject("Scripting.FileSystemObject")
With oFSO.GetFolder(StartOfPath)
    For Each SubDirectory In .SubFolders
        If UCase(Left(SubDirectory.Name, Len(StartOfFuzzyFolder))) = UCase(StartOfFuzzyFolder) Then
            GetActualFolderName = SubDirectory.Name
            Exit For
        End If
    Next SubDirectory
End With
'free memory
Set oFSO = Nothing
End Function

could anyone point me straight please

the way i have it set out is

Sub COPYandPRINT()
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=False
     
     PORow = PONUMBER.Value + 1
     
     Sheets("PURCHASE ORDER NUMBERS").Range("A" & PORow).Value = PONUMBER
     Sheets("PURCHASE ORDER NUMBERS").Range("B" & PORow).Value = SUPPLIER
     Sheets("PURCHASE ORDER NUMBERS").Range("C" & PORow).Value = xDATE
     Sheets("PURCHASE ORDER NUMBERS").Range("D" & PORow).Value = JOBNUMBER
     Sheets("PURCHASE ORDER NUMBERS").Range("E" & PORow).Value = CUSTOMERNAME
     Sheets("PURCHASE ORDER NUMBERS").Range("F" & PORow).Value = DESCRIPTION
     Sheets("purchase order").Select
     
     
Dim stOfPath As String
Dim ActualMidFolder As String
Dim EndOfNameAndPath As String
Dim FileNameToSave As String
Dim JobNum As String
Dim PONum As String
Dim SuppliersName As String

'define initial variables (note: the ranges may need to be changed
    JobNum = Range("G23").Value
    PONum = Range("k12").Value
    SuppliersName = Range("b16")
    EndOfNameAndPath = SuppliersName & " Purchase Order " & PONum & Format(Date, " dd.mm.yy") & ".xls"

'test to see if it is stock or PO (?) & define the saving path accordingly
    Select Case UCase(Left(JobNum, 1)) = "J"
        Case True
'Rob's test path:     stOfPath = "C:\Documents and Settings\HP_Owner\My Documents\"
            stOfPath = Range("B69") & "\"
            'test for any likely folders
                If Not (DoesFileFolderExist(stOfPath & JobNum & "*")) Then GoTo TheEnd
            'identify the exact folder
                ActualMidFolder = GetActualFolderName(stOfPath, JobNum) & "\"
            'define rest of file name
                EndOfNameAndPath = "Docs\" & EndOfNameAndPath
                FileNameToSave = stOfPath & ActualMidFolder & EndOfNameAndPath
        Case False
            stOfPath = Range("B70") & "\"
            If Not (DoesFileFolderExist(stOfPath)) Then GoTo TheEnd
                FileNameToSave = stOfPath & EndOfNameAndPath
    End Select

'save the file & finish macro
    ActiveWorkbook.SaveAs Filename:=FileNameToSave
    Exit Sub

TheEnd:
'warn nothing exists & end the macro
    MsgBox "Macro ending b/c no Folder with the following number exists : " & stOfPath & JobNum & "*", , "FYI"
    Debug.Print stOfPath & JobNum & "*"
End Sub

Public Function DoesFileFolderExist(strfullpath As String) As Boolean
'sourced from www.excelguru.ca/node/30 by Ken Puls
'note it only checks for the existence of the lowest folder (or the file) in the strfullpath string.
If Not Dir(strfullpath, vbDirectory) = vbNullString Then DoesFileFolderExist = True
End Function

Function GetActualFolderName(StartOfPath As String, StartOfFuzzyFolder As String)
'sourced & modified from http://www.themssforum.com/ExcelProgramming/parent-folder/
Dim oFSO As Object
Dim SubDirectory
Set oFSO = CreateObject("Scripting.FileSystemObject")
With oFSO.GetFolder(StartOfPath)
    For Each SubDirectory In .SubFolders
        If UCase(Left(SubDirectory.Name, Len(StartOfFuzzyFolder))) = UCase(StartOfFuzzyFolder) Then
            GetActualFolderName = SubDirectory.Name
            Exit For
        End If
    Next SubDirectory
End With
'free memory
Set oFSO = Nothing




     Range("B16:F19,K17:L20,B23:C24,G23:H24,I23:K24,B28:L57").Select
     Range("B16").Activate
     Selection.ClearContents
     Application.ScreenUpdating = True
     PONUMBER = PONUMBER + 1
     Range("B16").Select
     Application.DisplayAlerts = False
End Function

and i get run time error 91
object variable or with block variable not set
i click the debug button
and in yellow is this line