Hi,
The following is the same codes
https://1drv.ms/t/s!Ai8CrEskdewXvigLgpD5p1SnmAJt?e=G4RU6p
Unable to process file (VBA issue)
Peter_1985
2,526
Reputation points
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?
1 answer
Sort by: Most helpful
-
Peter_1985 2,526 Reputation points
2021-03-12T09:22:34.017+00:00