Save in two locations

[sassriverrat]

I'm trying to set a workbook up to save in two locations. Here's the fun part- below is coding that I put together that works- it saves the file on the desktop (as specified in the "local" directory cells (just addresses/names). However, I've been trying to place code within these three macros. I'd like the macros to each be able to save a .pdf copy of the active sheet only into the network folder (Basically report is to check if a "reports" folder exists, if yes, check if a folder in the "range" (maybe 1-50- user specified...), and if yes, save a pdf that's the name of the activesheet. If either of the first two is no, the macro creates the appropriate folder to satisfy a yes and proceeds).

You will see if my macros below where I started adding and then got stuck. Thanks for the help!

Note: second macro I started writing code and got stuck- trying to figure this for the network piece in case that wasn't clear- the local works as intended- just trying to save the active sheet each day to the network.
2nd Note: All three of these macros run at different times- the Save_As usually runs on the first active sheet. When the second sheet (now the active sheet) runs, the Daily_Saver usually runs and then when the last sheet becomes the active sheet, the SaveAsDirectory macro runs.

thanks again

Private Sub Save_As()
'Creates the SaveAs "Current Voyage" on the Noon Sheet


    Dim Path1 As String
    Dim Path2 As String
    Dim myfilename As String
    Dim fpathname As String
    Dim resp As Integer
    
    Path1 = Worksheets("Notes").Range("O17")
    myfilename = Worksheets("Notes").Range("O19") & ".xlsm"
    fpathname = Path1 & "\" & myfilename
    
    If ActiveWorkbook.Name = "Master Voyage Report.xlsm" Then
        ActiveSheet.EnableCalculation = False
    
        resp = MsgBox("You are trying to save the " & myfilename & " to:" & vbCrLf & fpathname, vbYesNo)
        If resp = vbYes Then
            ActiveWorkbook.SaveAs Filename:=fpathname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            'Application Closer
                If Workbooks.Count > 1 Then
                    ActiveWorkbook.Close
                Else: Application.Quit
                End If
        ElseIf vbNo Then
            Exit Sub
        ElseIf vbCancel Then
            Exit Sub
        End If
    ElseIf ActiveWorkbook.Name = myfilename Then
        ActiveWorkbook.Save
        'Application Closer
                If Workbooks.Count > 1 Then
                    ActiveWorkbook.Close
                Else: Application.Quit
                End If
    Else: ActiveWorkbook.Save
        'Application Closer
                If Workbooks.Count > 1 Then
                    ActiveWorkbook.Close
                Else: Application.Quit
                End If
    End If
End Sub


Private Sub SaveAsDirectory()
'Creates the SaveAs "#L/B and Ports" on the Arrival Sheet


    Dim Path1 As String
    Dim Path2 As String
    Dim Path3 As String
    Dim Path4 As String
    Dim Path5 As String
    Dim path6 As String
    Dim Path7 As String
    Dim Path8 As String
    Dim Path10 As String
    Dim Path11 As String
    Dim Path12 As String
    Dim myfilename As String
    Dim fpathname As String
    Dim oldpathme As String
    Dim oldnameme As String
    Dim jdrivepath As String
    Dim int1 As Integer:
    Dim int2 As Integer:
    Dim Path As String:
    Dim x As Integer:
    Dim fldr As String:
    Dim resp As Integer
    With Worksheets("Notes")
    Path1 = .Range("O26") '#
    Path2 = .Range("P26") 'L/B
    Path3 = .Range("Q26") 'Dep Port
    Path4 = .Range("R26") '-
    Path5 = .Range("S26") 'Arr Port
    Path7 = .Range("O16") 'Local Directory - SaveAs Directory
    Path8 = .Range("O18") 'name "Current Voyage Report"
    int1 = .Range("U23") 'user defined folder range - increments
    int2 = .Range("O26") 'voyage #
    Path = .Range("O22") 'Local Directory - SaveAs Archive Directory
    Path10 = .Range("U16") 'Local Folder Name
    Path11 = .Range("O20") 'Network Directory - Drive Daily Directory
    Path12 = .Range("U20") 'Network Directory - Folder Name
    End With
    x = Int((int2 - 1) / int1) * int1
    fldr = 1 + x & "-" & int1 + x
    
    myfilename = Path1 & Path2 & " " & Path3 & Path4 & Path5 & ".xlsm"
    fpathname = Path & "\" & fldr & "\" & myfilename
    oldnameme = Path8 & ".xlsm"
    oldpathme = Path7 & "\" & Path10 & "\" & oldnameme
    jdrivepath = Path11 & "\" & Path12
    
    ActiveSheet.EnableCalculation = False
    
    If ActiveWorkbook.Name = oldnameme Then
        resp = MsgBox("You are trying to save voyage " & myfilename & " to:" & vbCrLf & fpathname & vbCrLf & vbCrLf & "Current Voyage Report will be archived and the Master Voyage Report reset for next voyage. Thanks for using the OSG Voyage Reporting System!" & vbCrLf & vbCrLf & "File: " & int2 & vbTab & "Folder: " & fldr & vbCr & Path & "\" & fldr, vbYesNo)
            If resp = vbYes Then
                If Len(Dir(Path & "\" & fldr, vbDirectory)) = 0 Then MkDir Path & "\" & fldr
                    ActiveWorkbook.SaveAs Filename:=fpathname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            
' NETWORK coding 'ElseIf Len(Dir(jdrivepath & "\" & fldr, vbDirectory)) = 0 Then MkDir jdrivepath & "\" & fldr
' NETWORK coding 'ActiveWorkbook.SaveAs Filename:=fpathname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            'Call File Killer
                Kill (oldpathme)
            'Application Closer
                If Workbooks.Count > 1 Then
                    ActiveWorkbook.Close
                Else: Application.Quit
                End If
            ElseIf resp = vbNo Then
                Exit Sub
            ElseIf resp = vbCancel Then
                Exit Sub
            End If
            'Debug names
            Debug.Print ActiveWorkbook.Name
    ElseIf ActiveWorkbook.Name = myfilename Then
        ActiveWorkbook.Save
        'Application Closer
            If Workbooks.Count > 1 Then
                ActiveWorkbook.Close
            Else: Application.Quit
            End If
    ElseIf ActiveWorkbook.Name = "Master Voyage Report" & ".xlsm" Then
       resp = MsgBox("You are trying to save voyage " & myfilename & " to:" & vbCrLf & fpathname & vbCrLf & vbCrLf & "Current Voyage Report will be archived and the Master Voyage Report reset for next voyage. Thanks for using the OSG Voyage Reporting System!" & vbCrLf & vbCrLf & "File: " & int2 & vbTab & "Folder: " & fldr & vbCr & Path & "\" & fldr, vbYesNo)
           If resp = vbYes Then
                If Len(Dir(Path & "\" & fldr, vbDirectory)) = 0 Then MkDir Path & "\" & fldr
                    ActiveWorkbook.SaveAs Filename:=fpathname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            'Application Closer
                If Workbooks.Count > 1 Then
                    ActiveWorkbook.Close
                Else: Application.Quit
                End If
            ElseIf resp = vbNo Then
                Exit Sub
            ElseIf resp = vbCancel Then
                Exit Sub
            End If
    End If
End Sub


Private Sub DailySaver()
ActiveSheet.EnableCalculation = False
ActiveWorkbook.Save
 'Application Closer
    If Workbooks.Count > 1 Then
        ActiveWorkbook.Close
    Else: Application.Quit
    End If
End Sub

 

[sassriverrat]

bump

 

[higrm]

What isn't working? Does the macro crash? Which line? What error code? My guess, you have a typo. But I could be wrong.

 

[sassriverrat]

The macro crashes and I can't seem to recreate it.

On the two pieces of code before- both were taken from two different modules but they read EXACTLY the same. The second one was crashing and the first wasn't, but on the same exact line... here's the line before:

If Len(Dir(strfullname, vbdirectory)) = 0 Then