VBA to import .txt files

[John5]

Hello everyone

My company has a excel document that keeps records. I would like to automate this process and the first step is to import .txt documents into excel.

What I would like is help with the VBA that would automatically pull the info from the .txt files and put everything in it own cell that is separated by a space. The .txt files that are being imported will all be in one folder. It is possible that info in the .txt files will be updated here and there and possibly completely new info would be added so I would like the excel sheet to repopulate the info every time it is opened.

The next part is where I'm not sure how to proceed. Whether to have each .txt file in it own sheet or all in one sheet. Below is a example of the information in the txt file

sh ip int br
Interface IP-Address OK? Method Status Protocol
GigabitEthernet0/0.1999 1.1.1.1 YES NVRAM administratively down down
GigabitEthernet0/0.2002 2.2.2.22 YES NVRAM up up
GigabitEthernet0/1.1 3.3.3.3 YES NVRAM up up
GigabitEthernet0/1.2 4.4.4.4 YES NVRAM up up
GigabitEthernet0/1.10 5.5.5.5 YES NVRAM up up
GigabitEthernet0/1.11 6.6.6.6 YES NVRAM up up
GigabitEthernet0/1.200 7.7.7.7 YES manual administratively down down
GigabitEthernet0/1.210 8.8.8.8 YES NVRAM up up
Serial0/0/0 9.9.9.9 YES NVRAM down down
Tunnel500 10.10.10.10 YES manual up up
Test-RTR2821#
ex

Not all .txt files will have as many lines some only 5.

The over all Goal is to pull the name in the case above that is "Test-RTR2821#" then certain ip address along side it in a master sheet of sorts that would be used as a resource. See below.

Company name Transport Voice Data
Test-RTR2821 2.2.2.22 5.5.5.5 3.3.3.3
xxxxxx
xxxxx
xxxxx

....

What I don't know is once info has been imported would it be easier to pull the info out of one sheet or individual sheets that I need. Im also not sure how since non of the info will always be in the same cell.

side note I will have around 300 .txt documents to import

Any help with this would be greatly appreciated as I have been trying to figure this out using other VBA resources but have had no luck.

 

[SpillerBD]

I would do them all into one sheet. Much simpler when filtering, using Tables or Pivot Tables.
I have a macro I currently use that accomplishes. I'll be able to post later tonight when I get home.

 

[John5]

Thank you. How would you filter it out to the example I have above?

Company name Transport Voice Data
Test-RTR2821 2.2.2.22 5.5.5.5 3.3.3.3
xxxxxx


Would a pivot table give drop down option? For example I want to sort all info based on company then location

company A
Texas
Router 1 ip address's like above
Switch 1 ip address
Access point ip address

Where company drop down locations then locations drop down equipment at location and info to get to said equipment.

Or something like that? I am not to familiar with pivot tables.

 

[SpillerBD]

Pivot Table will both Group and allow filtering.
Check out the "slicers" if you have Excel 2010 or above. A similar feature, Time Line, was introduced with Excel 2013.

 

[SpillerBD]

This should get you pretty close to a working macro.
I use a file selection process so you include all files or just specific items to include.
I had usually used a "flag" method to ignore the headers tat might come from the txt files and set my own.

I usually run 300 files netting 250,000 - 500,000 rows with 15 columns including array formulas. Without the array formulas you should have a pretty fast import.

Sub IPAdressng_Txt_Only_Convert()

Dim strtext As String, StrBuFFer As String, FileToOpen As String, _
    fileToSave As String, MerchantID As String, BatchID As String, _
    CCRef As String
Dim CardTY As String, AuthCode As String, MySheetName1 As String
Dim TempCol1 As String, TempCol2 As String, TempCol3 As String, _
    TempCol4 As String, TempCol5 As String, TempCol6 _
    As String, TempCol7 As String, TempCol8 As String, TempCol9 As _
    String, TempCol10 As String, TempCol11 As String, TempCol12 _
    As String, TempCol13 As String, TempCol14 As String, TempCol15 _
    As String, TempCol16 As String, TempCol17 As String, TempCol18 _
    As String, TempCol19 As String, TempCol20 As String, TempCol21 _
    As String, TempCol22 As String
Dim Tab1 As Double, tab2 As Double, tab3 As Double, _
    tab4 As Double, tab5 As Double, tab6 As Double, _
    tab7 As Double, tab8 As Double
    
Dim HCCCounter As Double
Dim TAmount, BatchAmount As Double
Dim BatchDate As Date, TDate As Date
Dim fd As FileDialog
Dim VRTSelectedItem As Variant

Application.Calculation = xlManual

HCCCounter = 1
FileToOpen = ""
MySheetName1 = "IPAdressng"
Worksheets.Add.Name = MySheetName1
'Set headers on sheet
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 1).Value _
    = "Header1"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 2).Value _
    = "Header2"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 3).Value _
    = "Header3"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 4).Value _
    = "Header4"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 5).Value _
    = "Header5"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 6).Value _
    = "Header6"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 7).Value _
    = "Header7"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 8).Value _
    = "Header8"
    'Set additional headers on sheet
HCCCounter = HCCCounter + 1

MsgBox "Please select the appropriate TXT files for evaluation:" & vbCrLf & _
    "Select multiple IPAdressng files to be imported." & vbCrLf & _
    "(From the Same Folder)" & vbCrLf & _
    "Use SHIFT or CTRL to select multiple Files at once." & vbCrLf & vbCrLf & _
    "", vbInformation, ""

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Filters.Clear
    .Filters.Add ".txt Files", "*.txt"
    .AllowMultiSelect = True
If .Show = -1 Then
For Each VRTSelectedItem In .SelectedItems
' MsgBox "Processing file: " & vrtSelectedItem
Next
Else
Stop
End If

Application.ScreenUpdating = False
For Each VRTSelectedItem In .SelectedItems
    FileToOpen = VRTSelectedItem
    Open FileToOpen For Input As #1
    Do While Not EOF(1)
    Line Input #1, StrBuFFer 'Get text line and parse by tabs for first 21 columns, delimiter is comma
    StrBuFFer = Application.WorksheetFunction.Trim(StrBuFFer)
    StrBuFFer = Application.WorksheetFunction.Substitute(StrBuFFer, " ", vbTab)
    
If Len(StrBuFFer) > 6 Then
    'All data is initially handled as text strings.
    Tab1 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, 1)
        'Locates first Tab character in String
    TempCol1 = Mid(StrBuFFer, 1, Tab1) 'Captures value
    tab2 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, Tab1 + 1)
        'Locates next Tab in string
    TempCol2 = Mid(StrBuFFer, Tab1, tab2 - Tab1)
    tab3 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab2 + 1)
    TempCol3 = Mid(StrBuFFer, tab2, tab3 - tab2)
    tab4 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab3 + 1)
    TempCol4 = Mid(StrBuFFer, tab3, tab4 - tab3)
    tab5 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab4 + 1)
    TempCol5 = Mid(StrBuFFer, tab4, tab5 - tab4)
    'tab6 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab5 + 1)
    'TempCol6 = Mid(StrBuFFer, tab5, tab6 - tab5)
    'tab7 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab6 + 1)
    'TempCol7 = Mid(StrBuFFer, tab6, tab7 - tab6)
    'tab8 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab7 + 1)
    'TempCol8 = Mid(StrBuFFer, tab7, tab8 - tab7)
    

' TRIM & CLEAN to make sure non-printing characters including spaces, tab
' and carriage returns are not included in text values.
If Len(TempCol1) > 6 Then 'TempCol# only have valid data for this condition
    FieldOne = Trim(Application.WorksheetFunction.Clean(TempCol1))
    'None String variables could otherwise yield TYPE MISMATCH error
    FieldTwo = Trim(Application.WorksheetFunction.Clean(TempCol2))
    FieldThree = Trim(Application.WorksheetFunction.Clean(TempCol3))
    FieldFour = Trim(Application.WorksheetFunction.Clean(TempCol4))
    FieldFive = Trim(Application.WorksheetFunction.Clean(TempCol5))
    FieldSix = Trim(Application.WorksheetFunction.Clean(TempCol6))
    FieldSeven = Trim(Application.WorksheetFunction.Clean(TempCol7))
    FieldEight = Trim(Application.WorksheetFunction.Clean(TempCol8))


'Actual placement of data in cells
    Worksheets(ActiveSheet.Name).Cells(HCCCounter, 1).Value = "'" & FieldOne
    Worksheets(ActiveSheet.Name).Cells(HCCCounter, 2).Value = "'" & FieldTwo
    Worksheets(ActiveSheet.Name).Cells(HCCCounter, 3).Value = "'" & FieldThree
    Worksheets(ActiveSheet.Name).Cells(HCCCounter, 5).Value = "'" & FieldFour
    Worksheets(ActiveSheet.Name).Cells(HCCCounter, 4).Value = "'" & FieldFive
    Worksheets(ActiveSheet.Name).Cells(HCCCounter, 6).Value = "'" & FieldSix
    Worksheets(ActiveSheet.Name).Cells(HCCCounter, 7).Value = "'" & FieldSeven
    Worksheets(ActiveSheet.Name).Cells(HCCCounter, 8).Value = "'" & FieldEight
   
    HCCCounter = HCCCounter + 1 'set counter to next row for output.
End If
End If
Loop
Close
Next
Columns("A:H").EntireColumn.AutoFit
End With

Dim IPAdressngData As Range
Dim IPAdressngAuthCode As Range
ActiveWorkbook.Names.Add Name:="IPAdressngData", RefersToR1C1:= _
"=IPAdressng!R1C1:R" & (HCCCounter - 1) & "C8"

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Close 'close all open file handles
End Sub

 

[John5]

Thank you for this but may I bother you to explain it in more of a breakdown so I can understand it?

My target folder is C:\Users\name\Desktop\projects\excel documentation\Test folder Where does that go in the macro? I also saw IPAdressng referenced should i create a sheet with that name?

 

[SpillerBD]

The macro will op up a file navigator. As long as the files are available you would select. This is not automatic as you did describe.
You can set the default folder with

ChDir "C:\Users\name\Desktop\projects\excel documentation\Test folder"

CTRL+A selects all files and click OK

The creates that sheet. Looking over it I think if that sheet exist the macro fails because in this version I don't trap that error.

I do usually work with new workbooks instead of changing or updating an existing. Part Audit trail for me part previous month.

 

[John5]

I attempted to use it as you originally sent it with out specifying the folder in the VBA and I did get the pop up and selected my files but I received this error once I click OK.

Run-time eorror'1004':
Application-defined or object-defined error

I am running excel 2013

 

[John5]

Upon further testing I still get the error but if I only sleet 1 sheet it works but is unfortunately deleting the name of the device which is the last line of each .txt file

 

[SpillerBD]

How long is the text for the device name?
You'll see an IF statement that checks for string length. Currently set at 6. Set lower or comment the IF/END IF out so it evaluates every line....