CODEWITHSUNDEEP
excelvba
JNUG123
JNUG123

Reputation: 1

Excel VBA: Automating pasting data from notepad files to excel

As shown below I need to automate opening/saving/closing excel after pasting data from .txt files. A screenshot of the files is attached below.

The files are actually .cty files but will be opened using notepad.

The first excel file listed corresponds to the first .cty file, and the second excel file to the second .cty file, etc.

The excel file contains 4 tabs but I need the data pasted into two of those tabs, in cell A2 for both tabs as well. The tabs are titled "M6RURSpdVMT" and "M6URBSpdVMT". After pasting into cell A2, the data needs Text to Columns applied to it. (For Text to Columns it needs to be "Fixed width" and then "Finish").

Afterwards, the excel file can be saved and closed and then move onto the next set of files.

I found some code from a similar problem, shown below:

Option Explicit
Sub OpentxtSheets()
    Const sPath = "D:\Tests\" 'Change to suit
    Dim sFil As String
    Dim owb As Workbook
    Dim sh As Worksheet
 
    Set sh = Sheet1 'Change to suit
    sFil = Dir(sPath & "*.txt") 'Note it opens txt format
   
    Do While sFil <> ""
        Set owb = Workbooks.Open(sPath & sFil)
        Range("A1").CurrentRegion.Copy sh.Range("A65536").End(xlUp)(2)
        owb.Close False 'Close don't save
        sFil = Dir
    Loop
End Sub

And then I did a recording of what I wanted done with an excel and notepad file already open and this is what it gave me based on the steps I did:

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("M6RURSpdVMT").Select
    Range("A2").Select
    ActiveSheet.Paste
    Selection.TextToColumns Destination:=Range("A2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(4, 1), Array(12, 1), Array(20, 1), _
        Array(28, 1), Array(36, 1), Array(44, 1), Array(52, 1), Array(60, 1), Array(68, 1), Array( _
        76, 1), Array(84, 1), Array(92, 1), Array(100, 1), Array(108, 1)), TrailingMinusNumbers _
        :=True
    Sheets("M6URBSpdVMT").Select
    Range("A2").Select
    ActiveSheet.Paste
    Selection.TextToColumns Destination:=Range("A2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(4, 1), Array(12, 1), Array(20, 1), _
        Array(28, 1), Array(36, 1), Array(44, 1), Array(52, 1), Array(60, 1), Array(68, 1), Array( _
        76, 1), Array(84, 1), Array(92, 1), Array(100, 1), Array(108, 1)), TrailingMinusNumbers _
        :=True
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub

I need the whole thing to tie in together and have it open/save/close the files as I mentioned before. Please let me know if you need more details, thanks!

enter image description here

Upvotes: 0

Views: 239

Answers (1)

PeterT
PeterT

Reputation: 8557

Here is an example that I had fully working from an old test file. I did a quick modification to show how to get the data from your txt files.

This does not directly answer your question, but I think it may make your data transfer process a bit easier. It will directly look in a folder and take all of the CTY files in that folder and translate the data directly to a worksheet (without going through Text to Columns).

Give it a try and see if it helps.

Option Explicit

Sub test()
    Dim ctyFolder As String
    ctyFolder = "C:\Temp\cty\"
    
    Dim ctyFile As String
    ctyFile = Dir(ctyFolder & "*.dat")
    
    Dim ctyWS As Worksheet
    Do While ctyFile <> ""
        '--- use an existing worksheet or create a new one
        On Error Resume Next
        Set ctyWS = ThisWorkbook.Sheets(ctyFile)
        On Error GoTo 0
        If ctyWS Is Nothing Then
            Set ctyWS = ThisWorkbook.Sheets.Add
            ctyWS.Name = ctyFile
        Else
            ctyWS.Cells.Clear
        End If
        Debug.Print "processing " & ctyFolder & ctyFile
        ParseCTY ctyFolder & ctyFile, ctyWS
        ctyFile = Dir
        Set ctyWS = Nothing
    Loop
End Sub

Sub ParseCTY(ByVal filename As String, ByRef ws As Worksheet)
    Dim fileHandle As Integer
    fileHandle = FreeFile
    
    '--- open the file and create an array of all the lines in the file
    Dim allLines() As String
    Open filename For Input As #fileHandle
    allLines = Split(Input$(LOF(fileHandle), #fileHandle), vbNewLine)
    Close #fileHandle
    
    '--- look for lines that begin with a letter - NOT a space or a '#'
    Dim line As Variant
    Dim dataRow As Long
    dataRow = 1
    For Each line In allLines
        If (Left$(line, 1) <> " ") And (Left$(line, 1) <> "#") Then
            '--- this is a valid line, so pull out the data
            '    (assumes the tokens array index starts with 0)
            Dim i As Long
            Dim tokens() As String
            tokens = Split(line, ":")
            For i = LBound(tokens) To UBound(tokens)
                ws.Cells(dataRow, i + 1).Value = Trim$(tokens(i))
            Next i
            dataRow = dataRow + 1
        End If
    Next line
End Sub

Upvotes: 0

Related Questions