Saving PCDMIS file at end of program

Can anyone give me a code example for saving the entire PCDMIS file and CAD file in a certain location at the end of the program?

Thanks.

Parents

AndersI over 10 years ago

Here's a variation that automatically adds a number at the end of the file name (and increments it each call).
(It would be a good idea to enhance this with the safeguards in DaSalo's program)

' Add 1 to the file name, until an unused name is reached
Sub Increment(Filename As String, FilePath As String)

  Dim p As Integer
  Dim NewNumber As Integer

  Do
    p = InStr(1, UCase(FileName), ".PRG")
    If (p > 0) Then
      FileName = left(FileName, p-1)
    End If

    p = Len(FileName)
    While (p > 0) And (Instr(1, "0123456789", Mid(FileName, p, 1)) > 0)
      p = p - 1
    Wend

    NewNumber = Val(Right(FileName, Len(FileName)-p))

    FileName = Left(FileName, p) + Str(NewNumber + 1)  + ".PRG"

  On Error Resume Next
  Loop Until (FileLen(FilePath + FileName) = 0)
  On Error GoTo 0

End Sub

' Increment the file name and save
' NOTE: It's the prog with the new name that is open in
' PC-DMIS after this.

Sub IncrSave(FilePath As String)

  Dim FileName As String
  Dim DmisApp As Object
  Dim DmisPart As Object

' Connect to PC-DMIS
  Set DmisApp = CreateObject("PCDLRN.Application")
  Set DmisPart = DmisApp.ActivePartProgram

  FileName = DmisPart.Name

' Make sure the path ends in "\"
  If Len(FilePath) > 0 Then
    If Mid(FilePath, Len(FilePath),1) <> "\" Then
      FilePath = FilePath + "\"
    End If
  End If

' Increment the name and save the program
  Increment FileName, FilePath
  DmisPart.SaveAs FilePath + FileName

' finish
  Set DmisPart = Nothing
  Set DmisApp = Nothing

End Sub

' Just for testing
Sub Main
  IncrSave("C:\TEMP")
End Sub

Reply

AndersI over 10 years ago

Here's a variation that automatically adds a number at the end of the file name (and increments it each call).
(It would be a good idea to enhance this with the safeguards in DaSalo's program)

' Add 1 to the file name, until an unused name is reached
Sub Increment(Filename As String, FilePath As String)

  Dim p As Integer
  Dim NewNumber As Integer

  Do
    p = InStr(1, UCase(FileName), ".PRG")
    If (p > 0) Then
      FileName = left(FileName, p-1)
    End If

    p = Len(FileName)
    While (p > 0) And (Instr(1, "0123456789", Mid(FileName, p, 1)) > 0)
      p = p - 1
    Wend

    NewNumber = Val(Right(FileName, Len(FileName)-p))

    FileName = Left(FileName, p) + Str(NewNumber + 1)  + ".PRG"

  On Error Resume Next
  Loop Until (FileLen(FilePath + FileName) = 0)
  On Error GoTo 0

End Sub

' Increment the file name and save
' NOTE: It's the prog with the new name that is open in
' PC-DMIS after this.

Sub IncrSave(FilePath As String)

  Dim FileName As String
  Dim DmisApp As Object
  Dim DmisPart As Object

' Connect to PC-DMIS
  Set DmisApp = CreateObject("PCDLRN.Application")
  Set DmisPart = DmisApp.ActivePartProgram

  FileName = DmisPart.Name

' Make sure the path ends in "\"
  If Len(FilePath) > 0 Then
    If Mid(FilePath, Len(FilePath),1) <> "\" Then
      FilePath = FilePath + "\"
    End If
  End If

' Increment the name and save the program
  Increment FileName, FilePath
  DmisPart.SaveAs FilePath + FileName

' finish
  Set DmisPart = Nothing
  Set DmisApp = Nothing

End Sub

' Just for testing
Sub Main
  IncrSave("C:\TEMP")
End Sub

Children

No Data