Results 1 to 4 of 4

Thread: Save in two locations
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Oct 2018
    Posts
    469
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Save in two locations

    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

    Code:
    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

  2. #2
    Board Regular
    Join Date
    Oct 2018
    Posts
    469
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Save in two locations

    bump

  3. #3
    New Member
    Join Date
    Nov 2014
    Location
    Luxembourg
    Posts
    47
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Save in two locations

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

  4. #4
    Board Regular
    Join Date
    Oct 2018
    Posts
    469
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Save in two locations

    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:

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

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •