Exporteer hernoemde PDF's naar de bijbehorende map

Hoi allemaal

Ik heb geen soortgelijke berichten op het forum gevonden, dus ik neem de vrijheid om het te publiceren.

Omdat ik geen vaardigheden heb in VBA, heb ik een PDF-exportmacro op internet gevonden en ik wil deze wijzigen.

Momenteel wordt het MEP automatisch als pdf opgeslagen in de map waarin het bestand zich bevindt. Onze MEP-bestanden bevinden zich in een bibliotheek in een netwerk en worden "902xxxx" genoemd

Ik zou 2 extra functies nodig hebben:

  • Verhoog het nieuwe PDF-bestand "kamerplattegrond" aan het begin van de naam.
    = "Plattegrond 902xxxx"

  • Sla het PDF-bestand op een andere plaats op dan die in het MEP: de PDF's worden opgeslagen in een andere map en in submappen met de naam "902xx", maar in hetzelfde netwerk.

Voorbeeld:

Ik heb een "9021325" plan in U: Studies

Ik wil het met de macro in PDF opslaan zodat ze in de U-map terechtkomen: Dosfab / 90213 door zichzelf te hernoemen naar "kamerplan 9021325"

Hieronder vindt u de macro:

Dim swApp als object

Deel dimmen als object

Dim boolstatus als Booleaanse

Dim longstatus As Long, longwarnings As Long

Dim FeatureData als object

Dimfunctie als object

Component dimmen als object

Sub hoofd()

Stel swApp = Toepassing.SldWorks in

Deel instellen = swApp.ActiveDoc

Path = Deel.GetPathName

Part.SaveAs2 Left(Pad, (Len(Pad) - 6)) & " PDF ", 0, Waar, Onwaar

Set Deel = Niets

swApp.CloseDoc-pad

Einde Sub

Het doel is om de tijd te verminderen die wordt besteed aan het overschrijven van PDF-bestanden en het vinden ervan in de submappen die aan hun naam zijn gekoppeld.

Ik weet niet of het gemakkelijk te doen is.

Hallo @Tom_VITRE en welkom.

De zoekopdracht op dit forum is niet ideaal... en toch komen we door gewoon " PDF " te schrijven een aantal interessante resultaten tegen.
waarvan de bespreking:

Of nog beter:

Interessant vanwege de didactische kant.
@sbadenis biedt een goed becommentarieerde macro die u zonder al te veel moeite zou moeten kunnen wijzigen: (Hier is de kopie van de code).

' On définit les variables nécessaires
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim Path As String
Dim PathDesktop As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim nFileName2 As String
Dim FileName As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

'Dim lgFichier As Integer

Sub main()
' On se raccroche à Solidworks
Set swApp = Application.SldWorks

' On récupère le document actif dans Solidworks
Set swModel = swApp.ActiveDoc

' On vérifie qu'un document est bien ouvert dans Solidworks
If swModel Is Nothing Then
    MsgBox "Un document doit être actif dans Solidworks.", vbCritical
    End
End If

' On vérifie que le document ouvert dans Solidworks est un plan
If swModel.GetType <> swDocDRAWING Then
    MsgBox "Le document actif dans Solidworks doit être un plan.", vbCritical
    End
End If

' On vérifie que le plan ouvert dans Solidworks est bien enregistré
If swModel.GetPathName = "" Then
    swModel.Save
End If

' On récupère le chemin du dossier d'enregistrement du plan
Path = swModel.GetPathName

    
'on récupère le chemin complet sans le nom de fichier
FilePath = Left(Path, InStrRev(Path, "\"))
'Debug.Print "Filepath:" + Filepath
    
        
'on récupère le nom du fichier sans l'extension
FileName = Mid(Path, Len(FilePath) + 1, Len(Path) - (7 + Len(FilePath)))
' on affiche la variable dans la fenêtre Exécution
Debug.Print "FileName=" & FileName

' on affiche la variable dans la fenêtre Exécution
Debug.Print "Path=" & Path
lgFichier = InStrRev(Path, "\", -1, vbTextCompare) - 1
If lgFichier > 0 Then
    Path = Left(Path, lgFichier)
End If

' On récupère le chemin du bureau Windows
PathDesktop = Environ("USERPROFILE") & "\Desktop"
' on affiche la variable dans la fenêtre Exécution
Debug.Print "PathDesktop=" & PathDesktop

' On définit les paramètres d'export en PDF
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False

' On définit le chemin et le nom du premier fichier pdf à créer
'nFileName = Left(Path, Len(Path) - 6) & "PDF" 'Retrait de l'extension SW en gardant le point et ajout PDF
nFileName = FilePath & FileName & ".pdf"

' on affiche la variable dans la fenêtre Exécution
Debug.Print "nFileName=" & nFileName
' On sauvegarde le premier fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

' On définit le chemin et le nom du deuxième fichier pdf à créer
'nFileName2 = PathDesktop & Left(nFileName2, Len(nFileName2) - 6) & "PDF"
nFileName2 = PathDesktop & "\" & FileName & ".pdf"
' on affiche la variable dans la fenêtre Exécution
Debug.Print "nFileName2=" & nFileName2
' On sauvegarde le deuxième fichier pdf
boolstatus = swModelDocExt.SaveAs(nFileName2, 0, 0, swExportPDFData, lErrors, lWarnings)

End Sub

Vriendelijke groeten.

4 likes

Bedankt voor je antwoord, ik zal de tijd nemen om ernaar te kijken en het aan te passen met mijn instellingen

1 like