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
