question

Jackson1990-7147 avatar image
0 Votes"
Jackson1990-7147 asked ·

Unable to process file (VBA issue)

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-vba-devoffice-addins-dev
· 2
10 |1000 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

Formatting your code to make it readable.

However I do it by converting all ">" to newlines, and some > operators got accidentally converted this way. Although I've checked and add some back as I see there is "If" statement with condition obviously not boolean, I don't guarantee all is fixed this way.

You're strongly advised to paste your code here again.

0 Votes 0 ·

Hi, as this issue is not related to Office general issues, I would remove the tag "office-itpro".

0 Votes 0 ·

1 Answer

Jackson1990-7147 avatar image
0 Votes"
Jackson1990-7147 answered ·
·
10 |1000 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.