Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
fullevent
in reply to: moraesorlando

Hello @moraesorlando,

 

try this VBA-Code. I think its what you want.

Private Sub moraesorlando_KrA()
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument
    If Not ThisApplication.ActiveDocumentType = kAssemblyDocumentObject Then
        MsgBox "No assembly open..", vbCritical, "KrA"
        Exit Sub
    End If
    
    Dim origin_path As String, new_path As String, user_input As String, tmp_str As String
    Dim sFilesToCopy(9) As String
    
    user_input = InputBox("What is the new numebr", "YYYY-XXX", "")
    If Len(user_input) <> 8 Then
        MsgBox "Invalid input..", vbCritical, "KrA"
        Exit Sub
    End If
    
    origin_path = Left$(oDoc.FullFileName, InStrRev(oDoc.FullFileName, "\"))
    
    Dim oFileDlg As FileDialog
    Call ThisApplication.CreateFileDialog(oFileDlg)
    oFileDlg.Filter = "All Files (*.*)|*.*"
    oFileDlg.DialogTitle = "Pic file in destination folder"
    oFileDlg.InitialDirectory = origin_path
    oFileDlg.CancelError = True
    On Error Resume Next
    oFileDlg.ShowOpen

    If err Then
        MsgBox "User cancelled out of dialog"
        Exit Sub
    ElseIf oFileDlg.filename <> "" Then
        new_path = Left$(oFileDlg.filename, InStrRev(oFileDlg.filename, "\"))
    End If
    
    sFilesToCopy(0) = "DEPT-YYYY-XXX-05-01 SUPPORT.ipt"
    sFilesToCopy(1) = "DEPT-YYYY-XXX-05-01 SUPPORT.dwg"
    sFilesToCopy(2) = "DEPT-YYYY-XXX-04-01 EXTERNAL PLATE.ipt"
    sFilesToCopy(3) = "DEPT-YYYY-XXX-04-01 EXTERNAL PLATE.dwg"
    sFilesToCopy(4) = "DEPT-YYYY-XXX-03-01 INTERNAL PLATE.ipt"
    sFilesToCopy(5) = "DEPT-YYYY-XXX-03-01 INTERNAL PLATE.dwg"
    sFilesToCopy(6) = "DEPT-YYYY-XXX-02-01 SIDE LEFT PLATE.ipt"
    sFilesToCopy(7) = "DEPT-YYYY-XXX-02-01 SIDE LEFT PLATE.dwg"
    sFilesToCopy(8) = "DEPT-YYYY-XXX-01-01 SIDE RIGHT PLATE.ipt"
    sFilesToCopy(9) = "DEPT-YYYY-XXX-01-01 SIDE RIGHT PLATE.dwg"
    
    For i = 0 To 9
        tmp_str = "DEPT-" & user_input & Right$(sFilesToCopy(i), Len(sFilesToCopy(i)) - 13)
        Call ThisApplication.FileManager.CopyFile(origin_path & sFilesToCopy(i), new_path & tmp_str)
    Next

    MsgBox "I hope you like it", , "Done :)"
End Sub

 

regards, 


Aleksandar Krstic
Produkt- und Projektmanager