8 Replies Latest reply on Feb 5, 2018 3:20 PM by Alex Burnett

    Macro Issuse Network Folders vs Mapped Folders

    Andrew Collins

      Hi,

       

      I'm using a code from Keith Rice to save drawings off as PDF's in a specific location on our network.

       

      An issue we have run into is when the file we are trying to save as pdf was opened through the network drive we get "run-time error 52 bad filename or number" on line 45 of the code.

       

      \\XXXX\Design\DRAWINGS CONSTRUCTION\0-2018\Job Name\SolidWorks Files\Drawings

       

      vs

       

      N:\DRAWINGS CONSTRUCTION\0-2018\Job Name\SolidWorks Files\Drawings - This way runs the macro correctly.

       

      From my searches it looks as though the \\xxxx name isn't a valid name.We'd like to be able to run this macro from either location, is this possible?

       

      Thanks for any help.

       

      Const NEW_EXTENSION As String = "PDF"
      Const FOLDER_NAME As String = "Released Drawings"
        
      Sub main()
            
          If FOLDER_NAME = Empty Then Exit Sub
            
          Dim swApp As SldWorks.SldWorks
          Dim swModel As SldWorks.ModelDoc2
            
          Set swApp = Application.SldWorks
          Set swModel = swApp.ActiveDoc
            
          ' Create new file name
          Dim strModelPath As String
          Dim strSavePath As String
          Dim strSaveFolder As String
          Dim strFileName As String
          Dim vSplit As Variant
            
          strModelPath = swModel.GetPathName
        
          If swModel.GetPathName = Empty Then
              swApp.SendMsgToUser "Please save model."
              Exit Sub
          End If
        
          strFileName = Right(strModelPath, _
              Len(strModelPath) - InStrRev(strModelPath, "\"))
          vSplit = Split(strFileName, ".")
          strFileName = vSplit(0) & " REV_" & swModel.CustomInfo2("", "Revision") & "." & NEW_EXTENSION
            
          ' Create new directory
          vSplit = Split(strModelPath, "\")
            
          Dim intDirAbove As Integer
          Dim i As Integer
          Dim bFound As Boolean
            
          bFound = False
            
          For i = 0 To UBound(vSplit) - intDirAbove
              strSaveFolder = strSaveFolder & vSplit(i) & "\"
                
              If Dir(strSaveFolder & FOLDER_NAME, vbDirectory) <> Empty Then
                  bFound = True
                  Exit For
              End If
                
          Next i
            
          If bFound = False Then
              swApp.SendMsgToUser "Failed to find correct folder."
              Exit Sub
          End If
            
          strSavePath = strSaveFolder & FOLDER_NAME & "\" & strFileName
            
          Debug.Print "Original path: " & strModelPath
          Debug.Print "New save path: " & strSavePath
            
          ' Save
          bRet = swModel.Extension.SaveAs(strSavePath, swSaveAsCurrentVersion, _
              swSaveAsOptions_Silent, Nothing, Empty, Empty)
            
          If bRet = False Then swApp.SendMsgToUser "Problems saving file. Check if file is open"
      End Sub
      
      
        • Re: Macro Issuse Network Folders vs Mapped Folders
          Colt Carson

          I am assuming that N: is a mapped drive of \\xxxx\design\. You could do a string replace on strModelPath on line 21 to replace  \\XXXX\Design\ with  N:\  before proceeding with the rest of the macro. 

           

          • Re: Macro Issuse Network Folders vs Mapped Folders
            Alex Burnett

            See if this works for you. You were checking to see if the directory existed every time you added to the final path name which was causing errors. I moved the Dir() check outside the for loop and it seems to be working okay for me.

             

            Const NEW_EXTENSION As String = "PDF"
            Const FOLDER_NAME As String = "Released Drawings"
                
            Sub main()
                    
                If FOLDER_NAME = Empty Then Exit Sub
                    
                Dim swApp As SldWorks.SldWorks
                Dim swModel As SldWorks.ModelDoc2
                    
                Set swApp = Application.SldWorks
                Set swModel = swApp.ActiveDoc
                    
                ' Create new file name
                Dim strModelPath As String
                Dim strSavePath As String
                Dim strSaveFolder As String
                Dim strFileName As String
                Dim vSplit As Variant
                    
                strModelPath = swModel.GetPathName
                
                If swModel.GetPathName = Empty Then
                    swApp.SendMsgToUser "Please save model."
                    Exit Sub
                End If
                
                strFileName = Right(strModelPath, _
                    Len(strModelPath) - InStrRev(strModelPath, "\"))
                vSplit = Split(strFileName, ".")
                strFileName = vSplit(0) & " REV_" & swModel.CustomInfo2("", "Revision") & "." & NEW_EXTENSION
                    
                ' Create new directory
                vSplit = Split(strModelPath, "\")
                    
                Dim intDirAbove As Integer
                Dim i As Integer
                Dim bFound As Boolean
                
                bFound = False
                    
                For i = 0 To UBound(vSplit) - 1
                    strSaveFolder = strSaveFolder & vSplit(i) & "\"
                Next i
                
                If Dir(strSaveFolder & FOLDER_NAME, vbDirectory) <> Empty Then
                    bFound = True
                End If
                        
                    
                If bFound = False Then
                    swApp.SendMsgToUser "Failed to find correct folder."
                    Exit Sub
                End If
                    
                strSavePath = strSaveFolder & FOLDER_NAME & "\" & strFileName
                    
                Debug.Print "Original path: " & strModelPath
                Debug.Print "New save path: " & strSavePath
                    
                ' Save
                bRet = swModel.Extension.SaveAs(strSavePath, swSaveAsCurrentVersion, _
                   swSaveAsOptions_Silent, Nothing, Empty, Empty)
                    
                If bRet = False Then swApp.SendMsgToUser "Problems saving file. Check if file is open"
            End Sub
            
              • Re: Macro Issuse Network Folders vs Mapped Folders
                Andrew Collins

                Doesn't seem to work for me, cycles through the statement a few times till it errors out and fails to find folder location.

                  • Re: Macro Issuse Network Folders vs Mapped Folders
                    Alex Burnett

                    Andrew Collins wrote:

                     

                    Doesn't seem to work for me, cycles through the statement a few times till it errors out and fails to find folder location.

                    I think I see the issue, it's looking for the first root directory in your example. When I updated it, the "Released Files" folder would need to be in the same folder as the drawing.

                     

                    Example:

                    C:\Released Drawings\    would return as a valid drive and exit the loop.

                    \\MYSERVER\MYDRIVE\   The issue with the way it was running is that to find if this is a good drive, it checks to see if DIR("\Released Drawings") is a valid directory. It shouldn't return a value but it does. I was trying to find a way around this but got things too moved around. I'll keep looking at it for a bit.

                    • Re: Macro Issuse Network Folders vs Mapped Folders
                      Alex Burnett

                      Fixed Code with Error Checking:

                       

                      Const NEW_EXTENSION As String = "PDF"
                      Const FOLDER_NAME As String = "Released Drawings"
                          
                      Sub main()
                              
                          If FOLDER_NAME = Empty Then Exit Sub
                              
                          Dim swApp As SldWorks.SldWorks
                          Dim swModel As SldWorks.ModelDoc2
                              
                          Set swApp = Application.SldWorks
                          Set swModel = swApp.ActiveDoc
                              
                          ' Create new file name
                          Dim strModelPath As String
                          Dim strSavePath As String
                          Dim strSaveFolder As String
                          Dim strFileName As String
                          Dim vSplit As Variant
                          Dim directoryCheck As String
                              
                          strModelPath = swModel.GetPathName
                          
                          If swModel.GetPathName = Empty Then
                              swApp.SendMsgToUser "Please save model."
                              Exit Sub
                          End If
                          
                          strFileName = Right(strModelPath, _
                              Len(strModelPath) - InStrRev(strModelPath, "\"))
                          vSplit = Split(strFileName, ".")
                          strFileName = vSplit(0) & " REV_" & swModel.CustomInfo2("", "Revision") & "." & NEW_EXTENSION
                              
                          ' Create new directory
                          vSplit = Split(strModelPath, "\")
                              
                          Dim intDirAbove As Integer
                          Dim i As Integer
                          Dim bFound As Boolean
                              
                          bFound = False
                              
                          For i = 0 To UBound(vSplit) - intDirAbove
                              strSaveFolder = strSaveFolder & vSplit(i) & "\"
                                  
                                  
                              If Len(Replace(strSaveFolder, "\", "")) <> 0 Then
                                  On Error Resume Next
                                  directoryCheck = ""
                                  directoryCheck = Dir(strSaveFolder & FOLDER_NAME, vbDirectory)
                                  If Err.Number <> 0 Then
                                      Err.Clear
                                  End If
                                  If directoryCheck <> Empty Then
                                      bFound = True
                                      Exit For
                                  End If
                              End If
                                  
                          Next i
                              
                          If bFound = False Then
                              swApp.SendMsgToUser "Failed to find correct folder."
                              Exit Sub
                          End If
                              
                          strSavePath = strSaveFolder & FOLDER_NAME & "\" & strFileName
                              
                          Debug.Print "Original path: " & strModelPath
                          Debug.Print "New save path: " & strSavePath
                              
                          ' Save
                          'bRet = swModel.Extension.SaveAs(strSavePath, swSaveAsCurrentVersion, _
                          '    swSaveAsOptions_Silent, Nothing, Empty, Empty)
                          
                              
                          If bRet = False Then swApp.SendMsgToUser "Problems saving file. Check if file is open"
                      End Sub