Export from textpad to excel.

Posted on 2006-06-14
Last Modified: 2010-05-18
Does anyone has a shorter version of the code below..All I am trying to do is input .txt file to excel..My only concern is one line pointed below..I want the flexibility to change the numbers on this line.

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Program Files\" & myprojectName & "\This.TAB", Destination:=Range("A1"))
        .Name = "This"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(7, 7, 8, 15, 4, 12, 4, 16, 3, 10, 8, 3, 10, 10, 10, 10) <-----------------
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

Thank you.
Question by:Aiysha
  • 3
  • 2
LVL 35

Accepted Solution

[ fanpages ] earned 250 total points
ID: 16907830
How about...

   Workbooks.OpenText Filename:=C:\Program Files\" & myprojectName & "\This.TAB", Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= Array(Array(0, 1), Array(7, 1), Array(14, 1), Array(22, 1), Array(37, 1))

LVL 17

Assisted Solution

inthedark earned 250 total points
ID: 16910086
To handle large volumes of data into excel I found quickest method is to use Paste.

So you load your data form the file:

OK = ExcelCreateOK(ReadFIle("C:\MyData\Text.txt"))

You file must be formated like this:

Field1 + vbTab + Field2 + vbTab + LastColumnField + vbCRLF

Before you paste your data you can set the columns widths with a little mod to the code. I will post later.

Public Function ExcelCreateOK(FromData As String, Optional psFileName As String = "") As Boolean

' Fires up Excel and pastes data into a new workbook
' See class zExcel for a better version of this which allows formatting
' of columns

' OK = GF.ExcelCreateOK(sDataToPaste)

Const zxlNormal = -4143

Dim IDE As Boolean

' Are we running in IDE or EXE mode?
On Error Resume Next
Debug.Print 1 / 0
If Err.Number <> 0 Then
    IDE = True
End If
If IDE Then
    On Error GoTo 0
    On Error GoTo ErrorTrap
End If

' Create the Excel objects
Dim ExcelApp ' As Excel.Application
On Error Resume Next

Set ExcelApp = CreateObject("Excel.Application")

Dim WB ' As Excel.Workbook

' If no filename make visible to hold on screen
ExcelApp.Visible = Len(psFileName) = 0

' create a blank sheet
Set WB = ExcelApp.Workbooks.Add

' set app focus to the new sheet

' stuff the data onto clipboard
Clipboard.SetText FromData

' move clipboard to Excel
Clipboard.Clear ' release memory
If Len(psFileName) > 0 Then
    ' if a file name save and close Excel
    ExcelApp.ActiveWorkbook.SaveAs FileName:=psFileName, FileFormat:=zxlNormal, Password:="", _
        WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Set WB = Nothing
    Set ExcelApp = Nothing
    ' Allow Excel to stay on screen
    Set WB = Nothing
    Set ExcelApp = Nothing
End If

ExcelCreateOK = True
Exit Function

ErrN = Err.Number
ErrD = Err.Description
On Error Resume Next

ExcelCreateOK = False

End Function

LVL 17

Expert Comment

ID: 16910146
A little bit more code, but just a once in a lilfe time addition to your code and then you can forget about exporting to excel FOR EVER.  I just need an SQL statement. Or a disconnected recorset loaded with data. And 2 seconds later I have the report in Excel.

I created a class which could generate an Excel report from a recordset. With all of the trinckets of a nice report, titles, sub totals, bold bits, etc.

The cute move was to disconnect the recordset to allow for dynamic processing of column data, say for calculated columns, etc. I create a little form which allows editing of tiles, field captions and formats, sub totalling details, etc. And that was it, one day later no more coding ever.

So I create an AddColumn sub which needed just caption, width, justification and format spec, totaling details, for each column. Column data was saved into a UTD array (mvColdata)

Here is how the export starts....

To set column widths before past of data.

' define font
With EA.Selection.Font
    .Name = "Arial"
    .Size = 8
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = zxlUnderlineStyleNone
    .ColorIndex = zxlAutomatic
End With
EA.Selection.Font.Bold = False

Dim lc As Long

lc = 0
Do While lc <= mlColumns
    EA.Columns(mvColdata(lc).Name + ":" + mvColdata(lc).Name).Select
    With EA.Selection
        .VerticalAlignment = &HFFFFEFF5 'Excel.Constants.xlBottom
        .WrapText = False
        .Orientation = 0
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
        If Len(mvColdata(lc).FormatSpec) > 0 Then
            On Error Resume Next
            .NumberFormat = mvColdata(lc).FormatSpec
            On Error GoTo 0
            .NumberFormat = "General"
        End If
        If mvColdata(lc).Characters > 0 Then
            .ColumnWidth = mvColdata(lc).Characters
        End If
        Select Case mvColdata(lc).align
            Case Is = zExAlignment.zexLeft
                '.HorizontalAlignment = Excel.Constants.xlLeft
                .HorizontalAlignment = &HFFFFEFDD  'left
            Case Is = zExAlignment.zexRight
                 .HorizontalAlignment = &HFFFFEFC8  'right
            Case Else
                .HorizontalAlignment = &HFFFFEFF4   'center
        End Select
    End With
    lc = lc + 1


If Len(DataToPaste) > 0 Then
    Clipboard.SetText DataToPaste
    EA.ActiveSheet.Paste 'paste into excel
End If

My version of this class then goes on to setup Bold areas, underlines etc.

Just an idea for you. Do the job once, take a break forever.
LVL 35

Expert Comment

by:[ fanpages ]
ID: 17322161
That's fine with me, as long as it is OK with inthedark, thank you, Dan.
LVL 17

Expert Comment

ID: 17324689

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article ( for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

816 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now