Help With Vb Code

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Help With Vb Code

    Hi everyone. I have been tweaking and tweaking this code to get it to work, but cant seem to get there. Mind you I am new to VB coding. I have a little bit of my own coding and some other stuff I found on here and online to help me get to where I want to go. What I am attempting to do is to navigate to a specific directory, Search through the files in that directory (part number specific), and if the file in that directory has an extension of "PRG", it opens the part program and unmarks a few lines of code in said program, and continues searching through the files. But, Every time I try to run the sub, it exits right after reading the "For Each objFile in objFolder.Files" line. Can someone help me troubleshoot? Below I copied the code. Thanks.

    Sub UnmarkProgramNotificationPCDmis()


    Dim CurrentPath As String
    Dim FolderPath As String
    Dim Ppath As String
    Dim BCpath As String
    Dim ACpath As String
    Dim SAPnum As Integer
    Dim FileName As String
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim Ext As String



    Ppath = VBA.InputBox("Do you want to update a BC program, or and AC program? Type AC, or BC ")
    On Error GoTo Leave
    SAPnum = VBA.InputBox("Please Enter the SAP#")
    On Error GoTo Leave

    BCpath = "F:\Secure\Inspection\CMM Programs_Temporary_PCDmis" & "" & SAPnum
    ACpath = "F:\Secure\Inspection\CMM Programs_Temporary_PCDmis\AC_PROGRAMS" & "" & SAPnum
    MsgBox (BCpath)

    If Ppath = "BC" Then
    CurrentPath = BCpath
    Else: CurrentPath = ACpath
    End If

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(CurrentPath)
    Set app = CreateObject("PCDLRN.Application")
    app.WaitUntilReady (20)
    Set parts = app.PartPrograms

    For Each objFile In objFolder.Files
    Ext = UCase(Right(objFile.Name, Len(objFile.Name) - InStrRev(objFile.Name, ".")))
    If (Ext = "PRG") Then

    FileName = objFile.Name
    Set part = parts.Open(FileName, "Offline")
    app.Visible = False
    Set cmds = part.Commands

    For Each cmd In cmds


    If cmd.IsFileIOCommand Then
    FileName = cmd.FileIOCommand.FilePointerID

    If FileName = ("PART_COMPLETE") Then
    cmd.Marked = False


    End If

    End If

    Next cmd


    part.Close
    End If
    Next objFile



    Exit Sub
    Leave:
    MsgBox "An Error has occured, DUMBASS!!!!"

    Set app = Nothing
    Set part = Nothing
    Set parts = Nothing
    Set cmd = Nothing
    Set cmds = Nothing


    End Sub
    Last edited by Gagedude127; 07-22-2020, 12:07 PM.

  • #2
    Just a little update. After a whole day of banging my head off the wall, I finally figured it out! The updated code will be posted below if anyone needs to do something similar. Just to understand a little more of what I needed to do. We store our PCDmis programs in 2 directories. A permanent folder, which is locked so operators cannot access, and is used for programs that have been proved out. Then we have a temporary folder for NEW programs that haven't been proved out. For all new programs I have a FileIO command that writes the part# to a text file when the program has ran all the way through. So then I go review the report for that part and make sure nothing is wonky, then move the program over to the permanent folder so our operators do not have to run the CMM in slow thinking part has never been ran before. The problem I have with the FileIO command is you have to go unmark those couple "writeline" commands or else every time the part runs, its prints to that text file. So I have to manually have to go into each program, and "blue" those lines out when moving to the permanent folder. I could have written a code to paste the actually directory in my input box so it would do it for one single program, but the problem is we have many different CMM's so we have the same program in subfolder after subfolder for each machine. So I wanted a to write a code where it found the part number folder and searched through each individual subfolder and updated every instance of that program. The code on this original post was only searching for the file one subfolder deep so it was kicking out of the loop. We typically have at least 2 or 3 subfolders until you find the actual program, so I found another way to get to it. Here it is.


    Sub UnmarkProgramNotification()
    Dim FSOLibrary As Object
    Dim FSOFolder As Object
    Dim folderName As String
    Dim Ppath As String
    Dim CurrentPath As String
    Dim SAPnum As String
    Dim ACpath As String
    Dim BCpath As String
    Dim myFile As Variant


    Ppath = VBA.InputBox("Do you want to update a BC program, or and AC program? Type AC, or BC ")


    SAPnum = VBA.InputBox("Please Enter The Program Name")


    BCpath = "F:\Secure\Inspection\CMM Programs_Temporary_PCDmis" & "" & SAPnum & ""
    ACpath = "F:\Secure\Inspection\CMM Programs_Temporary_PCDmis\AC_PROGRAMS" & "" & SAPnum & ""


    If Ppath = "BC" Then
    CurrentPath = BCpath
    Else: CurrentPath = ACpath
    End If

    myFile = SAPnum & ".PRG"

    'Set the folder name to a variable
    folderName = CurrentPath

    'Set the reference to the FSO Library
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")

    'Another Macro must call LoopAllSubFolders Macro to start
    LoopAllSubFolders FSOLibrary.GetFolder(folderName), myFile



    Exit Sub



    End Sub
    Sub LoopAllSubFolders(FSOFolder As Object, myFile)

    Dim FSOSubFolder As Object
    Dim FSOFile As Object
    Dim MyPath As String
    Dim MyCommand As Object
    Dim CurrCommand As String




    'For each subfolder call the macro
    For Each FSOSubFolder In FSOFolder.subfolders
    LoopAllSubFolders FSOSubFolder, myFile
    Next


    For Each FSOFile In FSOFolder.Files

    'Insert the actions to be performed on each file
    If FSOFile.NAME = "" Then GoTo Done
    If FSOFile.NAME = myFile Then




    'Create an instance for PCDmis
    Set app = CreateObject("PCDLRN.Application")
    MyPath = FSOFile.Path
    'Debug.Print MyPath

    'Wait for PCDmis to load up
    app.WaitUntilReady (20)

    'set program to active part program
    Set parts = app.PartPrograms
    Set part = parts.Open(MyPath, "Offline")
    app.Visible = False
    Set cmds = part.Commands

    For Each cmd In cmds
    Debug.Print cmd.ID


    If cmd.IsFileIOCommand Then
    Set MyCommand = cmd.FileIOCommand
    Debug.Print MyCommand.FilePointerID
    CurrCommand = MyCommand.FilePointerID


    If CurrCommand = ("PART_COMPLETE") Then
    cmd.Marked = False


    End If

    End If

    Next cmd

    part.Close


    End If
    'Debug.Print FSOFile.NAME
    Next
    Done:
    'Release Memory of Objects
    Set app = Nothing
    Set part = Nothing
    Set parts = Nothing
    Set cmd = Nothing
    Set cmds = Nothing
    Set MyCommand = Nothing

    End Sub



    Comment


    • #3
      Well done & thanks for sharing.

      FYI this is called a recursive call (where a function or subroutine calls itself).
      Automettech - Automated Metrology Technology

      Comment


      • #4
        Originally posted by NinjaBadger View Post
        Well done & thanks for sharing.

        FYI this is called a recursive call (where a function or subroutine calls itself).
        I found this out and had to do some research on it afterwards! I've noticed one problem with the code now. The commands that I am unmarking are in a group, and if that group is toggled open it does not unmark my 3 lines of code. But, As long as the group is closed it works? haha it's quite odd that makes a difference. Any Idea what I could do make it work regardless of that group being toggled open or not?

        Comment


        • NinjaBadger
          NinjaBadger commented
          Editing a comment
          Write code to look for group commands first, and if they're hidden un-hide them

      • #5
        I have a script that marks code in groups, not seen any issues so far. Though, the groups start with internal documentation so it may perhaps just not have any obvious consequences.

        Comment

        Related Topics

        Collapse

        Working...
        X