1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Solved: Export Quote and Comma Delimited file from Excel

Discussion in 'Business Applications' started by 69Transam, Dec 21, 2011.

Thread Status:
Not open for further replies.
Advertisement
  1. 69Transam

    69Transam Thread Starter

    Joined:
    Dec 21, 2011
    Messages:
    8
    Just found the site, amazing work.
    I have a project where I need to export a comma and quote delimited text file. I am running W7 and O2007.
    On Aril 8, 2007 Rollin_Again posted the code below. I see you are still active, could I impose on you for a couple of changes?
    > One, if the field is blank there is no need for quotes.
    > Two, I do not need Quotes on the first 2 fields/columns.
    >Third, there is a space before and after every comma that is not needed.

    My file only has 20-30 rows by 22 columns so cleaning this up is not a BIG deal, but since it is Christmas I thought I would ask.

    TIA

    Code:
    Public Sub ExportText()
    
    Dim fso
    Dim aArray As Variant
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fsoText = fso.CreateTextFile("C:\Test.txt", True)
    
    vCol = Left(Columns(Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column).Address(0, 0), 2 + (Cells.Find(What:="*", After:=[A1], _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column < 27))
    
    For i = 2 To Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    ReDim aArray(1 To 1, 1 To Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column)
    
    aArray = Range("A" & i & ":" & vCol & i).Value
    
    For x = 1 To Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column
    
    If vString = "" Then
    vString = Chr(34) & aArray(1, x) & Chr(34)
    Else
    vString = vString & " , " & Chr(34) & aArray(1, x) & Chr(34)
    End If
    
    Next x
    
    fsoText.WriteLine (vString)
    vString = ""
    
    Next i
    
    MsgBox ("TEXT EXPORT COMPLETE")
    fsoText.Close
    
    Set fso = nothing
    set aArray = nothing
    
    End Sub
    
     
  2. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,912
    Did you get this sorted yet?

    Rollin
     
  3. 69Transam

    69Transam Thread Starter

    Joined:
    Dec 21, 2011
    Messages:
    8
    I played with the code, ever so slightly, but couldn't get there. One change that ran did cause the first column to not have quotes though, but that was pure luck. Was trying to follow how vString got populated. 117 onlookers, must me of interest to others.

    Appreciate any intelligence you can add to my lack thereof...:eek:

    Code:
    Public Sub ExportText()
    Dim fso
    Dim aArray As Variant
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fsoText = fso.CreateTextFile("C:\Users\RPayton\Desktop\CBIZ.csv", True)
    vCol = Left(Columns(Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column).Address(0, 0), 2 + (Cells.Find(What:="*", After:=[A1], _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column < 27))
    For i = 2 To Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ReDim aArray(1 To 1, 1 To Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column)
    aArray = Range("A" & i & ":" & vCol & i).Value
    For x = 1 To Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column
    If vString = "" Then
    'vString = Chr(34) & aArray(1, x) & Chr(34)
    vString = aArray(1, x)
    Else
    vString = vString & "," & Chr(34) & aArray(1, x) & Chr(34)
    End If
    Next x
    fsoText.WriteLine (vString)
    vString = ""
    Next i
    MsgBox ("TEXT EXPORT COMPLETE from Results Sheet")
    fsoText.Close
    Set fso = Nothing
    Set aArray = Nothing
    End Sub
    
    
     
  4. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,912
    Try this modified code.

    Code:
    Public Sub ExportText()
    Dim fso
    Dim aArray As Variant
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fsoText = fso.CreateTextFile("C:\Users\RPayton\Desktop\CBIZ.csv", True)
    vCol = Left(Columns(Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column).Address(0, 0), 2 + (Cells.Find(What:="*", After:=[A1], _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column < 27))
    For i = 2 To Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ReDim aArray(1 To 1, 1 To Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column)
    aArray = Range("A" & i & ":" & vCol & i).Value
    For x = 1 To Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious).Column
    
    Select Case x
    Case 1 To 2
    If vString = "" Then
    vString = aArray(1, x)
    Else
    vString = vString & "," & aArray(1, x)
    End If
    Case Else
    vString = vString & "," & Chr(34) & aArray(1, x) & Chr(34)
    End Select
    Next x
    
    vString = Replace(vString, Chr(34) & Chr(34), "")
    
    fsoText.WriteLine (vString)
    vString = ""
    Next i
    MsgBox ("TEXT EXPORT COMPLETE from Results Sheet")
    fsoText.Close
    Set fso = Nothing
    Set aArray = Nothing
    End Sub
    
    
    Regards,
    Rollin
     
  5. 69Transam

    69Transam Thread Starter

    Joined:
    Dec 21, 2011
    Messages:
    8
    U R The Man! Thanks a million.
    I think you've been on this Board longer than most people keep their jobs!
     
  6. Sponsor

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1032275

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice