rpt file to excel

[vineet78]

Hi I can develop easy VBA programs but facing difficulty since whole day in converting RPT file (saved as .txt) to .xlsx format.
Can you help please?

 

[Joe4]

Without knowing what the report actually looks like, and what you need it to look like when imported into Excel, we really cannot provide any sort of specific help.

It might be helpful if you can post images of samples of what the original data looks like, and then what you want the end result to look like in Excel. Note you can post images in this thread using this tool here: XL2BB - Excel Range to BBCode

 

[vineet78]

Here is how report first page looks like..

 

[Joe4]

OK, so that is half of what I asked for.
Now, what do you want the data in Excel to look like?

 

[vineet78]

Hi, It is an .rpt file saved as .txt file.
I am trying to get the same data in excel format and seperated by columns as is appearing in text/rpt file.
But when I am trying text to columns, alignment is not coming proper.

thanks for your reply

 

[Joe4]

The reason why you cannot use Text to Columns on it to split it into different columns is because not every row is split in the same places. You have all sorts of header and trailer rows of differing length.

I had to deal with these kind of reports years ago, and what we did was import the entire contents of the file into column A, and using VBA, loop through each row, one at a time, and identify what kind of row it is, and then based on that, split out the columns for that row, and then move on to the next row and repeat.

I would identify the row by looking at the first bunch of characters, and see what they start with (i.e. "Date", "User", "Vendor", "Aging", etc).

Note that this was NOT an easy or fast task. It took a lot of trial and error and a lot of time to develop. These things really are a pain to work with, even for experienced VBA programmers. It is so much better if you can get the data in an actual data export format, instead of a printed report format.

 

[vineet78]

Please find required excel report as attached below

 

[vineet78]

Yes Joe, understand your point. i was just thinking if there is an already prepared VBA code to convert RPT files to Excel. I got one code from my search but there is giving one error , just fyi, sending code below. it is giving error on SysCmd -saying Sub of Function not defined..can it be of some help?

Function RPTtoExcel(strFileIn As String, strFileOut As String) As Boolean
Dim objExcel As Excel.Application
Set objExcel = CreateObject("Excel.Application")
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet, ws2 As Excel.Worksheet
Dim nRecordCount As Long, nCurSec As Long
Dim RetVal As Variant, nCurRec As Long, dnow As Date
Dim nTotalSeconds As Long, nSecondsLeft As Long
Dim nGuide(999, 2) As Long, nTotalColumns As Long

Dim strGuide As String, strHeaders As String, strValues() As String, strValue As Variant
Dim strInput As String, strOutput As String, nCurrent As Long, nCurrentLine
Dim nCurrentRow As Long, nCurrentColumn As Long

On Error Resume Next
RetVal = SysCmd(acSysCmdInitMeter, "Transferring " & strFileIn & " to " & strFileOut & ". . .", nRecordCount)

Rem *** Get Guide ***
Open strFileIn For Input As #1
Input #1, strHeaders
strHeaders = Mid(strHeaders, 4, 9999) 'Skip three bytes of garbage
Input #1, strGuide
Do While Not EOF(1) 'Count the number of records...
Input #1, strInput
nRecordCount = nRecordCount + 1
Loop
Close #1
RetVal = SysCmd(acSysCmdInitMeter, "Converting " & strFileIn & " to " & strFileOut & ". . .", nRecordCount)

Rem *** Build the numeric guide. ***
'This works as an offset and length system to show how to break up
'each fixed-width line.
nGuide(1, 1) = 1 'Start with the offset for the first column (1 of course!)
strGuide = strGuide & " " 'Trigger addition of the last column.
For nCurrent = 1 To Len(strGuide)
If Mid(strGuide, nCurrent, 1) = " " Then 'Split here
nTotalColumns = nTotalColumns + 1
nGuide(nTotalColumns, 2) = nCurrent - nGuide(nTotalColumns, 1) 'Length does not include current space.
nGuide(nTotalColumns + 1, 1) = nCurrent + 1 'Set the offset for next column.
End If
Next

Open strFileIn For Input As #1

Rem *** Start with a fresh spreadsheet ***
objExcel.DisplayAlerts = False
Set wb = objExcel.Workbooks.Add
wb.Worksheets(3).Delete
wb.Worksheets(2).Delete
wb.Worksheets(1).Name = strFileIn
Set ws = wb.Worksheets(1)
ws.Name = "Sheet 1"

nCurrentRow = 1
nCurrentLine = 0
nCurSec = Second(Now())
Do While nCurSec = Second(Now()) 'Get to next second...
Loop
nCurSec = Second(Now())
Rem *** Skip the headers and guide ***
Line Input #1, strInput
Line Input #1, strInput

Do While Not EOF(1)
Line Input #1, strInput
nCurRec = nCurRec + 1
If Second(Now()) <> nCurSec And nCurRec < nRecordCount Then
nCurSec = Second(Now())
nTotalSeconds = nTotalSeconds + 1
If nTotalSeconds > 3 Then
RetVal = SysCmd(acSysCmdUpdateMeter, nCurRec)
RetVal = DoEvents()
End If
End If
strOutput = ""
If nCurrentRow = 1 Then
For nCurrent = 1 To nTotalColumns
ReDim Preserve strValues(nCurrent - 1)
strValues(nCurrent - 1) = Trim(Mid(strHeaders, nGuide(nCurrent, 1), nGuide(nCurrent, 2)))
ws.Range(FindExcelCell(nCurrent, nCurrentRow)).NumberFormat = "Text"
ws.Range(FindExcelCell(nCurrent, nCurrentRow)) = strValues(nCurrent - 1)
ws.Range(FindExcelCell(nCurrent, nCurrentRow)).Font.Bold = True
ws.Range(FindExcelCell(nCurrent, nCurrentRow)).Interior.Color = RGB(222, 222, 222)
Next
End If

nCurrentRow = nCurrentRow + 1

For nCurrent = 1 To nTotalColumns
strValues(nCurrent - 1) = Trim(Mid(strInput, nGuide(nCurrent, 1), nGuide(nCurrent, 2)))
Next
Rem *** Next line blasts values into a range that fits the data. For example, if the
Rem *** nCurrentRow is 17 and there are 24 columns then the range is "A17:X17".
ws.Range(FindExcelCell(1, nCurrentRow) & ":" & FindExcelCell(nTotalColumns, nCurrentRow)).NumberFormat = "Text"
ws.Range(FindExcelCell(1, nCurrentRow) & ":" & FindExcelCell(nTotalColumns, nCurrentRow)) = strValues()
If nCurrentRow = 1000000 Then
Rem *** Start a new tab once we hit a million rows. ***
Set ws = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
ws.Name = "Sheet " & wb.Worksheets.Count
nCurrentRow = 1 'Start at the top and add header row.
End If

Loop
Close #1
'File must be created. Save and then close without saving.
objExcel.Workbooks(1).SaveAs (strFileOut)
objExcel.Workbooks(1).Close (False)
'Cleanup...
Set wb = Nothing
Set ws = Nothing
Set objExcel = Nothing
RetVal = SysCmd(acSysCmdRemoveMeter)
End Function

 

[Joe4]

The issue is that the layout every file is different. There isn't "one size fits all" code, because it doesn't know where fields start/end. You have to give the code that information.

If you found some code elsewhere that you think might be able to be adapted to your situation, your best bet is probably to get in contact with the person who created that code. In looking at the code myself, it uses some methods that I do not use myself.

 

[vineet78]

Thanks Joe, i will search more about it.