Export from textpad to excel.

Posted on 2006-06-14
Medium Priority
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
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
LVL 35

Accepted Solution

[ fanpages ] earned 1000 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 1000 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

Want to be a Web Developer? Get Certified Today!

Enroll in the Certified Web Development Professional course package to learn HTML, Javascript, and PHP. Build a solid foundation to work toward your dream job!

Question has a verified solution.

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

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

762 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