Option Explicit
Const const1 = "------------ -------"
Const const2 = "Main company Patient"
Const const3 = "ACCOUNTS RECEIVABLE "
Const const4 = "company Consolidate"
Const const5 = "Estimated pricing: "
Const const6 = "Exclusion criteria: "
Const const7 = "Selection criteria: "
Const const8 = "Sort criteria: "
Const const9 = "Summary only: "
Const const10 = "--------------------"
Const const11 = " "
Const const12 = "User:"
Const const13 = "* * * * * R e p o r t S u m m a r y"
Const constspaces = " "
Sub process_file_ardata()
Dim wWork_sheet As Worksheet
Dim wWork_Book As Workbook
Dim nfreefile As Long
Dim iFileHandle As Integer
Dim sFile As String
Dim sWorkvar As String
Dim sValue1 As String
Dim sValue2 As String
Dim sValue3 As String
Dim sValue4 As String
Dim sValue5 As String
Dim sValue6 As String
Dim sValue7 As String
Dim sValue8 As String
Dim sValue9 As String
Dim sValue10 As String
Dim sValue11 As String
Dim sValue12 As String
Dim sDataline As String
Dim iRow As Long
Dim bProc As Boolean
iRow = 2
Set wWork_Book = Excel.Application.Workbooks.Add
Set wWork_sheet = wWork_Book.Worksheets(1)
wWork_sheet.Cells(1, 1).Value = "ACCOUNT"
wWork_sheet.Cells(1, 2).Value = "NAME / RESPONSIBLE PARTY"
wWork_sheet.Cells(1, 3).Value = "CHG TO"
wWork_sheet.Cells(1, 4).Value = "INVOICE NO."
wWork_sheet.Cells(1, 5).Value = "PHONE"
wWork_sheet.Cells(1, 6).Value = "BILLED DATE"
wWork_sheet.Cells(1, 7).Value = "BALANCE"
wWork_sheet.Cells(1, 8).Value = "NEXT PROC"
wWork_sheet.Cells(1, 9).Value = "SERVICE DATE"
wWork_sheet.Cells(1, 10).Value = "LAST DATE"
wWork_sheet.Cells(1, 11).Value = "AMOUNT"
wWork_sheet.Cells(1, 12).Value = "AGE"
sFile = Excel.Application.GetOpenFilename
iFileHandle = FreeFile()
Open sFile For Input As iFileHandle
Do While Not EOF(iFileHandle)
Line Input #iFileHandle, sDataline
If Len(sDataline) > 1 Then
sWorkvar = Mid(sDataline, 74, 1)
Select Case sWorkvar
Case "/"
bProc = True
Case Else
bProc = False
End Select
If bProc Then ' we have a valid line. Now we need to split it and put it on the correct cells.
' There are two options. 1- the most common is to have a invoice number within the field limits
' 2- the other less common is when the invoice number is greater than the field and passes to the next field
' This can be determined by a "-" on position 56. If true them we have option 2.
If Mid(sDataline, 56, 1) = "-" Then
sValue1 = Trim(Mid(sDataline, 1, 12))
sValue2 = Trim(Mid(sDataline, 13, 24))
sValue4 = Trim(Mid(sDataline, 44, 14))
sValue5 = Trim(Mid(sDataline, 58, 14))
Else
sValue1 = Trim(Mid(sDataline, 1, 11))
sValue2 = Trim(Mid(sDataline, 12, 25))
sValue4 = Trim(Mid(sDataline, 44, 13))
sValue5 = Trim(Mid(sDataline, 57, 15))
End If
sValue3 = Trim(Mid(sDataline, 37, 7))
sValue6 = Trim(Mid(sDataline, 72, 10))
sValue7 = Trim(Mid(sDataline, 83, 10))
sValue8 = Trim(Mid(sDataline, 94, 4))
sValue9 = Trim(Mid(sDataline, 99, 10))
sValue10 = Trim(Mid(sDataline, 110, 10))
sValue11 = Trim(Mid(sDataline, 121, 8))
sValue12 = Trim(Mid(sDataline, 130, 3))
wWork_sheet.Cells(iRow, 1).Value = sValue1
wWork_sheet.Cells(iRow, 2).Value = sValue2
wWork_sheet.Cells(iRow, 3).Value = sValue3
wWork_sheet.Cells(iRow, 4).Value = sValue4
wWork_sheet.Cells(iRow, 5).NumberFormat = "@"
wWork_sheet.Cells(iRow, 5).Value = sValue5
wWork_sheet.Cells(iRow, 6).Value = sValue6
wWork_sheet.Cells(iRow, 7).NumberFormat = "#.00"
wWork_sheet.Cells(iRow, 7).Value = sValue7
wWork_sheet.Cells(iRow, 8).Value = sValue8
wWork_sheet.Cells(iRow, 9).Value = sValue9
wWork_sheet.Cells(iRow, 10).Value = sValue10
wWork_sheet.Cells(iRow, 11).NumberFormat = "#.00"
wWork_sheet.Cells(iRow, 11).Value = sValue11
wWork_sheet.Cells(iRow, 12).Value = sValue12
iRow = iRow + 1
End If
End If
Loop
Close iFileHandle
End Sub
Sub process_file()
Dim wWork_sheet As Worksheet
Dim wWork_Book As Workbook
Dim nfreefile As Long
Dim iFileHandle As Integer
Dim sFile As String
Dim sValue1 As String
Dim sValue2 As String
Dim sValue3 As String
Dim sValue4 As String
Dim sValue5 As String
Dim sDataline As String
Dim iRow As Long
Dim iRow_error As Long
Dim sWorkvar As String
Dim bProc As Boolean
Dim bNew As Boolean
iRow = 2
Set wWork_Book = Excel.Application.Workbooks.Add
Set wWork_sheet = wWork_Book.Worksheets(1)
wWork_sheet.Cells(1, 1).Value = "ACCESSION"
wWork_sheet.Cells(1, 2).Value = "PATIENT"
wWork_sheet.Cells(1, 3).Value = "DATE"
wWork_sheet.Cells(1, 4).Value = "CLIENT"
wWork_sheet.Cells(1, 5).Value = "ERROR"
wWork_sheet.Cells(1, 6).Value = "ESTIMATED PRICING"
sFile = Excel.Application.GetOpenFilename
iFileHandle = FreeFile()
Open sFile For Input As iFileHandle
Do While Not EOF(iFileHandle)
Line Input #iFileHandle, sDataline
If Len(sDataline) > 1 Then
bProc = True
sWorkvar = Mid(sDataline, 1, 20)
If Mid(sDataline, 15, 40) = const13 Then
Exit Do ' Don't process more lines as we are at the end of valid data
End If
Select Case sWorkvar
Case const1, _
const2, _
const3, _
const4, _
const5, _
const6, _
const7, _
const8, _
const9, _
const10, _
const11
bProc = False
Case Else
If Mid(sWorkvar, 1, 5) = const12 Then
bProc = False
End If
End Select
If bProc Then ' we have a valid line. Now we need to split it and put it on the correct cells.
If Not Mid(sDataline, 1, 1) = " " Then
sValue1 = Mid(sDataline, 1, 12)
sValue2 = Mid(sDataline, 14, 30)
sValue3 = Mid(sDataline, 46, 11)
sValue4 = Mid(sDataline, 59, 8)
sValue5 = Mid(sDataline, 69, 12)
wWork_sheet.Cells(iRow, 1).Value = sValue1
wWork_sheet.Cells(iRow, 2).Value = sValue2
wWork_sheet.Cells(iRow, 3).Value = sValue3
wWork_sheet.Cells(iRow, 4).Value = sValue4
wWork_sheet.Cells(iRow, 6).Value = sValue5
bNew = True
Else
If bNew Then
iRow = iRow - 1
bNew = False
End If
wWork_sheet.Cells(iRow, 1).Value = sValue1
wWork_sheet.Cells(iRow, 2).Value = sValue2
wWork_sheet.Cells(iRow, 3).Value = sValue3
wWork_sheet.Cells(iRow, 4).Value = sValue4
wWork_sheet.Cells(iRow, 6).Value = sValue5
wWork_sheet.Cells(iRow, 5).Value = Mid(sDataline, 16, Len(sDataline) - 15)
End If
iRow = iRow + 1
End If
End If
Loop
Close iFileHandle
End Sub