Unable to process file (VBA issue)

Peter_1985 2,526 Reputation points
2021-03-12T08:43:53.593+00:00

Hi, I expect the following codes

 Sub A_Validate_Path_160606()   
 Dim Obj0 As Object, Source0 As Object, File0 As Variant, File1 As String, File2 As String, Pos0 As Integer, Pos1 As Integer, Pos2 As Integer, Pos3 As Integer, iFile As Integer, TextLine As String, Str0 As String, Command0 As String, FSO As Object, Path0 As String, Message0 As String   
 Dim RetVal, Str3 As String, Str4 As String   
   
 If Dir("C:\cmp3g\CODECO_ERROR_a\List0.txt") <  
 "" Then   
 Kill ("C:\cmp3g\CODECO_ERROR_a\List0.txt")   
 End If   
 If Dir("C:\cmp3g\CODECO_ERROR_a\error.txt") <  
 "" Then   
 Kill ("C:\cmp3g\CODECO_ERROR_a\error.txt")   
 End If   
 Set FSO = CreateObject("scripting.filesystemobject")   
 File0 = Dir("C:\cmp3g\CODECO_ERROR_a*.*", 7)   
 Do While (File0 <  
 "" And UCase(File0) <  
 "ERROR.TXT")   
 Debug.Print File0   
 File1 = "C:\cmp3g\CODECO_ERROR_a\" & File0   
 iFile = FreeFile   
 Open File1 For Input As #iFile   
 Do Until EOF(1)   
 Line Input #1, TextLine   
   
 If Mid(TextLine, 1, 4) = "UNA:" Then   
 If Not EOF(1) Then   
 Line Input #1, TextLine   
 End If   
 End If   
   
 If Trim(TextLine) <  
 "" Then   
 Pos0 = InStr(TextLine, "UNOA")   
 'Pos0 = InStr(TextLine, "UNOC")   
   
 If Not (Pos0 > 0) Then   
 Pos0 = InStr(TextLine, "KECA:")   
 If Not (Pos0 > 0) Then   
 Pos0 = InStr(TextLine, "UNB+")   
 End If   
 End If   
   
 If (Pos0 > 0) Then   
 Debug.Print "xx0817"   
 Pos1 = InStr(Pos0 + 1, TextLine, "+")   
 Pos2 = InStr(Pos1 + 1, TextLine, "+")   
 Pos3 = InStr(Pos1 + 1, TextLine, ":")   
   
 If Pos3 < Pos2 Then   
 Pos2 = Pos3   
 End If   
   
 Message0 = ""   
 Str0 = Mid(TextLine, Pos1 + 1, Pos2 - 1 - Pos1)   
 'Debug.Print Str0   
 If Len(Str0) > 0 Then   
 Path0 = "C:\cmp3g\CODECO_ERROR_a\" & Str0 & "\"   
   
 If FSO.FolderExists(Path0) = False Then   
 'Command0 = "cmd /c mkdir """ & Path0 & """ "   
 'Shell (Command0)   
 MkDir (Path0)   
   
 'DoEvents   
 'Application.Wait Now + TimeValue("00:00:07")   
   
 End If   
   
 If UCase(File0) <  
 "ERROR.TXT" And UCase(File0) <  
 "INVALID_PORT.TXT" Then   
 'Command0 = "cmd /c copy /y ""C:\cmp3g\CODECO_ERROR_a\" & File0 & """ ""C:\cmp3g\CODECO_ERROR_a\" & Str0 & """ "   
 Command0 = "copy /y ""C:\cmp3g\CODECO_ERROR_a\" & File0 & """ ""C:\cmp3g\CODECO_ERROR_a\" & Str0 & """ "   
 Debug.Print Command0   
 'RetVal = Shell(Command0)   
 'Shell (Command0)   
 Str3 = "C:\cmp3g\CODECO_ERROR_a\" & File0: Str4 = "C:\cmp3g\CODECO_ERROR_a\" & Str0   
 'FileCopy Str3 Str4   
 Dim sSrcFile As String   
 Dim sDesFile As String   
   
 sSrcFile = "C:\cmp3g\CODECO_ERROR_a\" & File0   
 sDesFile = "C:\cmp3g\CODECO_ERROR_a\" & Str0 & "\" & File0   
 'CreateObject("Wscript.Shell").Run "cmd /c copy /y " & Chr(34) & sSrcFile & Chr(34) & " " & Chr(34) & sDesFile & Chr(34), 0, True   
   
 Dim oFSO As Object   
 Set oFSO = CreateObject("Scripting.FileSystemObject")   
 Call oFSO.CopyFile(sSrcFile, sDesFile, True)   
   
 'FileCopy "C:\cmp3g\CODECO_ERROR_a\" & File0 "C:\cmp3g\CODECO_ERROR_a\" & Str0   
 'Debug.Print File0 & " x1 " & Str0   
 'Debug.Print File2 & " x2 " & Str0   
 DoEvents   
 Application.Wait Now + TimeValue("00:00:11")   
   
 File2 = File0   
 'Validate_File Str0, File0, Message0   
 Shell ("C:\cmp3g\CODECO_ERROR_a\Validate_File1 """ & Str0 & """ """ & File2 & """")   
 End If   
   
 Exit Do   
 End If   
   
 End If   
 End If   
 Loop   
 Close #iFile   
   
 File0 = Dir   
 Loop   
 End Sub  

would be able to process EDI file attached. But it doesn't. Can you help?

77131-codeco-aumeldpc-in2103091616.txt

Office Development
Office Development
Office: A suite of Microsoft productivity software that supports common business tasks, including word processing, email, presentations, and data management and analysis.Development: The process of researching, productizing, and refining new or existing technologies.
3,532 questions
{count} votes

1 answer

Sort by: Most helpful
  1. Peter_1985 2,526 Reputation points
    2021-03-12T09:22:34.017+00:00
    0 comments No comments