Excel Programming VBA - export fields into a text file

Question

I have the following VBA code which reads from a text file and populates columns in an excel worksheet.

I would like to enhance this code to read the text file (already does this), store the name of the text file and create a text file (with the same name and output) in a designated location.

Currently the "output" is stored in the worksheet columns, but I want to create a text file instead (with the same name of the source text file).

Can we take it a level higher and have the macro read any text file in the folder and create new text files....

Thanks, as a VBA beginner, I was able to take it this far... from there on...I need help!

Thanks,

Sub CommandButton2_Click()

   Dim regex As Object

   Dim file  As Variant

   Dim lName As Long

   Dim lSize As Long

   Dim temp_size As Long

   Dim temp_size2 As Long

   Dim line  As String

   Dim found As Boolean

   file = Application.GetOpenFilename("text files (*.txt), *.txt")

   If file <> False Then

      Set regex = CreateObject("VBScript.RegExp")

      'regex.Pattern = "^\s*(Name|Size):?(.*)$"

      regex.Pattern = "^.*?(Name|Size):(.*)$"

      regex.IgnoreCase = True

      With CreateObject("Scripting.FileSystemObject").OpenTextFile(file, 1, False)

         While Not .AtEndOfStream

            line = .ReadLine

            If InStr(1, line, "Target", vbTextCompare) > 0 Then found = True

            If found Then

               With regex.Execute(line)

                  If .Count > 0 Then

                     If LCase(.Item(0).Submatches(0)) = "name" Then

                       lName = lName + 1

                       Cells(lName, "h") = UCase(Trim(.Item(0).Submatches(1)))

                       Cells(lName, "e") = "OTHER"

                       Cells(lName, "F") = "50"

                       Cells(lName, "G") = "HEADER:"

                       Cells(lName, "I") = ":"

                     Else

                       lSize = lSize + 1

                          If lSize = 1 Then

                           Cells(lSize, "a") = 1

                           temp_size = 1

                          Else

                           Cells(lSize, "a") = temp_size + temp_size2

                           temp_size = temp_size2

                          End If

                       Cells(lSize, "d") = UCase(Trim(.Item(0).Submatches(1)))

                       temp_size2 = UCase(Trim(.Item(0).Submatches(1)))

                     End If

                  End If

               End With

            End If

         Wend

         .Close

      End With

   End If

End Sub

Answer 1

Love the interface, will implement that in my code...

Thanks again.

Answer 2

Sorry I'm late:  http://home.arcor.de/peter.schleif/ExportFields.xls

Peter

Answer 3

never mind... I got it!

Thanks,

Answer 4

Work perfectly!

Thank you,

Answer 5

Peter Schleif schrieb am 06.07.2010 17:41 Uhr:

I have tested it with "test.txt", which I had then uploaded.

http://home.arcor.de/peter.schleif/test.txt

With this file, the code generates the following output.

1,,,50,OTHER,50,HEADER:,COUNTY,:

51,,,17,OTHER,50,HEADER:,SLPARCEL 2,:

67,,,18,OTHER,50,HEADER:,SLPARCEL 3,:

35,,,19,OTHER,50,HEADER:,SLPARCEL 4,:

This corresponds to the Excel output of your code.

+-----+-----+-----+-----+-------+-----+---------+------------+-----+

|  A  |  B  |  C  |  D  |   E   |  F  |    G    |     H      |  I  |

+-----+-----+-----+-----+-------+-----+---------+------------+-----+

|   1 |     |     |  50 | OTHER |  50 | HEADER: | COUNTY     |  :  |

+-----+-----+-----+-----+-------+-----+---------+------------+-----+

|  51 |     |     |  17 | OTHER |  50 | HEADER: | SLPARCEL 2 |  :  |

+-----+-----+-----+-----+-------+-----+---------+------------+-----+

|  67 |     |     |  18 | OTHER |  50 | HEADER: | SLPARCEL 3 |  :  |

+-----+-----+-----+-----+-------+-----+---------+------------+-----+ |  35 |     |     |  19 | OTHER |  50 | HEADER: | SLPARCEL 4 |  :  |

+-----+-----+-----+-----+-------+-----+---------+------------+-----+

Peter

Answer 6

The below code asks for input folder and output folder. All text files in the input folder are processed and the output files will be written. The columns are simply separated by commas. Note: This is not a regular CSV file. Commas within fields are not masked.

I have tested it with "test.txt", which I had then uploaded. Your test file was probably somewhat different. So I'm not sure if it works for you. Please let me know.

Peter

Sub ExportFieldsIntoTextFiles()

   Dim regex        As Object

   Dim lName        As Long

   Dim lSize        As Long

   Dim line         As String

   Dim found        As Boolean

   Dim row(1 To 9)  As String  'columns A:I

   Dim rows()       As Variant

   Dim temp_size    As Long

   Dim temp_size2   As Long

   Dim file_input   As Variant

   Dim file_output  As Variant

   Dim dir_input    As Variant

   Dim dir_output   As Variant

   Set dir_input = CreateObject("Shell.Application").BrowseForFolder(0, "Input folder", &H245)

   If dir_input Is Nothing Then Exit Sub

   dir_input = dir_input.Self.Path & ""

   Set dir_output = CreateObject("Shell.Application").BrowseForFolder(0, "Output folder", &H245)

   If dir_output Is Nothing Then Exit Sub

   dir_output = dir_output.Self.Path & ""

   Set regex = CreateObject("VBScript.RegExp")

   regex.Pattern = "^.*?(Name|Size):(.*)$"

   regex.IgnoreCase = True

   For Each file_input In CreateObject("Scripting.FileSystemObject").GetFolder(dir_input).Files

      If LCase(Right(file_input.Name, 4)) = ".txt" Then

         With file_input.OpenAsTextStream(1)

            rows  = Array()

            found = False

            lName = 0

            lSize = 0

            While Not .AtEndOfStream

               line = .ReadLine

               If InStr(1, line, "Target", vbTextCompare) > 0 Then found = True

               If found Then

                  With regex.Execute(line)

                     If .Count > 0 Then

                        If LCase(.Item(0).Submatches(0)) = "name" Then

                           lName = lName + 1

                           If lName > UBound(rows) Then

                              ReDim Preserve rows(lName)

                              rows(lName) = row

                           End If

                           rows(lName)(8) = UCase(Trim(.Item(0).Submatches(1)))  'column H

                           rows(lName)(5) = "OTHER"                              'column E

                           rows(lName)(6) = "50"                                 'column F

                           rows(lName)(7) = "HEADER:"                            'column G

                           rows(lName)(9) = ":"                                  'column I

                        Else

                           lSize = lSize + 1

                           If lSize > UBound(rows) Then

                              ReDim Preserve rows(lSize)

                              rows(lSize) = row

                           End If

                           If lSize = 1 Then

                              rows(lSize)(1) = 1                                 'column A

                              temp_size = 1

                           Else

                              rows(lSize)(1) = temp_size + temp_size2            'column A

                              temp_size = temp_size2

                           End If

                           rows(lSize)(4) = UCase(Trim(.Item(0).Submatches(1)))  'column D

                           temp_size2 = UCase(Trim(.Item(0).Submatches(1)))

                        End If

                     End If

                  End With

               End If

            Wend

            .Close

         End With

         With CreateObject("Scripting.FileSystemObject").CreateTextFile(dir_output & file_input.Name, True)

            For lName = 1 To UBound(rows)

               .WriteLine Join(rows(lName), ",")

            Next

            .Close

         End With

      End If

   Next

End Sub