'Convert "\QuickTX\lbArgs.txt" to Excel

On Error Resume Next
Set ObjExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
  Wscript.Echo "You must have Excel installed to perform this operation."
Else
  Set fso = CreateObject("Scripting.FileSystemObject")
  myTxtFile = ""
  myXlsFile = ""
  ' Input via Arguments
  For I = 0 to WScript.Arguments.Count - 1
    If fso.FileExists(WScript.Arguments.Item(I)) Then
      Select Case UCase(Right(WScript.Arguments.Item(I),4))
        Case ".TXT"
          myTxtFile = WScript.Arguments.Item(I)
        Case ".XLS"
          myXlsFile = WScript.Arguments.Item(I)
      End Select
    End If
  Next
  'Input via Explorer
  If myTxtFile = "" Then 
    Set ObjFSO = CreateObject("UserAccounts.CommonDialog")
    ObjFSO.Filter = "Text File|*.txt"
    ObjFSO.FilterIndex = 3
    ObjFSO.ShowOpen
    myTxtFile = ObjFSO.FileName
  End If
  If myTxtFile <> "" Then
    If myXlsFile = "" Then 
      Set ObjFSO = CreateObject("UserAccounts.CommonDialog")
      ObjFSO.Filter = "Excel File|*.xls"
      ObjFSO.FilterIndex = 3
      ObjFSO.ShowOpen
      myXlsFile = ObjFSO.FileName
    End If
  End If
  'Call the Convert Procedure
  If myTxtFile <> "" and myXlsFile <> ""  Then
    Call DoConvert(myTxtFile,myXlsFile)
  End If   
End If

Sub DoConvert(txtFile,xlsFile)
  On Error Resume Next
  Dim vCtm(4), vVioDate(4)
  Set inFile = fso.OpenTextFile(txtFile, 1)
  col = 1
  row = 1
  'Create Excel file & Workbooks
  ObjExcel.Visible = False
  Set objWorkbook  = ObjExcel.Workbooks.Open(xlsFile)
  'Get the last Row
  Do Until ObjExcel.Cells(row,1).Value = ""
    row = row + 1
  Loop
  ObjExcel.Cells(row,1).Value = "Quote" & Row-1
  'Get all the info in Row 1 
  Do Until ObjExcel.Cells(1,col).Value = ""
    Redim Preserve dHead(col)
    dHead(col) = Ucase(ObjExcel.Cells(1,col).Value)
    col = col + 1
  Loop
  'Loop file & copy info to Excel
  Do until inFile.AtEndOfStream
    dLine = inFile.ReadLine
    'Get info from line, Separator is the = 
    EqualPos = InStr(dLine,"=")
    dIni = Ucase(Mid(dLine, 1, EqualPos-1))
    dEnd = Mid(dLine, EqualPos+1, Len(dLine) - EqualPos + 1)
    'Handle Special Cases
    If Left(dIni,6) = "DVDATE" Then
      vVioDate(CInt(Right(dIni,1))) = vVioDate(CInt(Right(dIni,1))) & ValidStrDate(dEnd) & ";"
    End If
    
    If Left(dIni,5) = "VCTM_" Then
      If CInt(dEnd) > 0 then
        Select Case Left(dIni,7)
          Case "VCTM_ST"
            vCtm(CInt(Right(dIni,1))) = vCtm(CInt(Right(dIni,1))) & "S=" & dEnd & ";"
          Case "VCTM_CO"
            vCtm(CInt(Right(dIni,1))) = vCtm(CInt(Right(dIni,1))) & "C=" & dEnd & ";"
          Case "VCTM_EX"
            vCtm(CInt(Right(dIni,1))) = vCtm(CInt(Right(dIni,1))) & "E=" & dEnd & ";"
          Case "VCTM_IN"
            vCtm(CInt(Right(dIni,1))) = vCtm(CInt(Right(dIni,1))) & "I=" & dEnd & ";"
          Case "VCTM_PA"
            vCtm(CInt(Right(dIni,1))) = vCtm(CInt(Right(dIni,1))) & "P=" & dEnd & ";"
          Case "VCTM_PR"
            vCtm(CInt(Right(dIni,1))) = vCtm(CInt(Right(dIni,1))) & "F=" & dEnd & ";"
          Case "VCTM_TO"
            vCtm(CInt(Right(dIni,1))) = vCtm(CInt(Right(dIni,1))) & "T=" & dEnd & ";"
        End Select
      End If
    else
      Select Case Left(dIni,7)
        Case "DPRIORL" 'Add and "A"
          dIni = Left(dIni,7) & "A" & Mid(dIni,8,Len(dIni)) 
        Case "VIN_NUM" 'Remove the "_1"
          dIni = Left(dIni,10) & Right(dIni,1)
        Case "VBI_LIM" 'Remove the "_1"
          dIni = Left(dIni,7)
        Case "VPD_LIM" 'Remove the "_1"
          dIni = Left(dIni,7)
        Case "VPIP_LI" 'Remove the "_1"
          dIni = Left(dIni,8)
        Case "VUM_LIM" 'Remove the "_1"
          dIni = Left(dIni,7)
        Case "VUMPD_L" 'Remove the "_1"
          dIni = Left(dIni,9)
        Case "VMED_LI" 'Remove the "_1"
          dIni = Left(dIni,8)
        Case "VFAKEOP" 'Remove the "_1"
          dIni = "VOPTIONS_" & right(dIni,1)
        Case "VOPTION" 'Remove the "_1"
          dIni = ""
      End Select
      If InStr(dEnd, " ") then
        dEnd = chr(34) & dEnd & chr(34)
      End If
      'Check if it exists in the headers
      For I = 1 to col - 1
        If dIni = dHead(I) Then 
          ObjExcel.Cells(row,I).Value = dEnd
          Exit For
        End If
      Next
    End If
  Loop
  'Check if Custom_Type exists in the headers
  For J = 1 to 4
    dLabel1 = "VCUSTOM_TYPE" & J
    dLabel2 = "DVDATE" & J
    For I = 1 to col - 1
      If dLabel1 = dHead(I) Then 
        ObjExcel.Cells(row,I).Value = vCtm(J)
      End If
      If dLabel2 = dHead(I) Then 
        ObjExcel.Cells(row,I).Value = vVioDate(J)
      End If
    Next
  Next
  'AutoFit all columns
  With ObjExcel
    .Cells.Select
    .Cells.EntireColumn.AutoFit
    .Range("A1").Select
    'Save Excel File & Close Excel Object
    '.ActiveWorkbook.SaveAs(txtFile & ".xls")
    .ActiveWorkbook.Save 
    .Workbooks(1).Close
    .Quit
  End With
  MsgBox("Done!!!")
End Sub

Function ValidStrDate(sStr)
  sMM = Left(sStr, (InStr(sStr, "/") - 1))
  sMM = String((2 - Len(sMM)), "0") & sMM
  sStr = Mid(sStr, (InStr(sStr, "/") + 1), (Len(sStr) - InStr(sStr, "/")))
  sDD = Left(sStr, (InStr(sStr, "/") - 1))
  sDD = String((2 - Len(sDD)), "0") & sDD
  sStr = Mid(sStr, (InStr(sStr, "/") + 1), (Len(sStr) - InStr(sStr, "/")))
  sYY = String((4 - Len(sStr)), "0") & sStr
  ValidStrDate = sMM & "/" & sDD & "/" & sYY
End Function