VBA code to copy text files to worksheet

[sans holo]

I am trying to put together some code to have Excel to copy all the text files from a folder with numerous text files, all of which have identical formatting, to one worksheet. Futhermore, I need the copying event to occur everytime the workbook is opened so that it will "refresh/overwrite" the worksheet with all of the files in the folder.

I have lifted some code from several sites which would seem to an untrained eye to accomplish what I am trying to get done, however I run into a file path error.

If anyone has to know of some good code and efficient code to accomplish this I would greatly appreciate it.

 

[bertie]

Try this in a standard module, Insert => Module.

There is a RefreshSheet() procedure which deletes the old sheet ("Temp") and create a new one.
The data will be imported into this sheet.

Edit the constant variables at the top of the code to meet your needs.

[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=#ff0000]
Const sPath = "C:\Temp[/COLOR]\" [COLOR=green]'remember end backslash[/COLOR]
[COLOR=#ff0000]Const delim = ","[/COLOR] [COLOR=green]'comma delimited text file - EDIT[/COLOR]
[COLOR=green]'Const delim = vbTab  'for TAB delimited text files[/COLOR]




[COLOR=darkblue]Sub[/COLOR] ImportMultipleTextFiles()
   [COLOR=darkblue]Dim[/COLOR] wb [COLOR=darkblue]As[/COLOR] Workbook
   [COLOR=darkblue]Dim[/COLOR] sFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] inputRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   
   RefreshSheet  
   
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
   sFile = Dir(sPath & "*.txt")
   
   [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] sFile = ""
      inputRow = Sheets("Temp").Range("A" & Rows.Count).End(xlUp).Row + 1
      
      [COLOR=green]'open the text file
[/COLOR][COLOR=#008000]'format=6 denotes a text file[/COLOR]
      [COLOR=darkblue]Set[/COLOR] wb = Workbooks.Open(Filename:=sPath & sFile, _
         Format:=6, _
         Delimiter:=delim)
      
      [COLOR=green]'copy and paste[/COLOR]
      wb.Sheets(1).Range("A1").CurrentRegion.Copy _
         Destination:=ThisWorkbook.Sheets("Temp").Range("A" & inputRow)
      wb.Close SaveChanges:=[COLOR=darkblue]False[/COLOR]
      
      [COLOR=green]'get next text file[/COLOR]
      sFile = Dir()
   [COLOR=darkblue]Loop[/COLOR]
   
   [COLOR=darkblue]Set[/COLOR] wb = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]


[COLOR=darkblue]Sub[/COLOR] RefreshSheet()
   [COLOR=green]'delete old sheet and add a new one[/COLOR]
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
   
   Application.DisplayAlerts = [COLOR=darkblue]False[/COLOR]
      Sheets("Temp").Delete
   Application.DisplayAlerts = [COLOR=darkblue]True[/COLOR]
   
   Worksheets.Add
   ActiveSheet.Name = "Temp"
   
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
[COLOR=darkblue]End[/COLOR] Sub

 

[sanjeevkumargirdhar]

Hi,

I have bit similar requirement, I have a data in notepad files.

I want to select a text file then data of text file copy line by line in excel in column C. After that i select another file and data copy line by line in column E.

Sanjeev Girdhar

 

[bertie]

Hi, and welcome to the forum.

For future reference I would advise starting a new thread for your problem rather than reviving one that is one-year-old. By all means, feel free to send me a pm requesting I have a look if you feel I could help.

The code below allows you to open text files until you click Cancel on the dialogue box.
The output column starts at C=3, and increments by two for each input file.
Output row is initialize = 1, assumed header row.
Output sheet = "Sheet1".

Place the code in a standard module, Insert = > Module.

Option Explicit


Sub ImportTextFiels()
   Dim sInputFile As String
   Dim sInputRecord As String
   Dim bContinue As Boolean
   Dim outCol As Long
   Dim outRow As Long
   Dim fNum As Long


   outCol = 1
   bContinue = True
   On Error GoTo errHandler
   
   Do While bContinue = True
      outRow = 1
         
      sInputFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
      If sInputFile = "False" Then
         bContinue = False
         Reset 'close any opened text file
         Exit Sub
      
      Else
         outCol = outCol + 2
         
         'process text file
         fNum = FreeFile
         Open sInputFile For Input As #fNum
         
         Do While Not EOF(fNum)
            outRow = outRow + 1
            Line Input #fNum, sInputRecord
            Sheets("Sheet1").Cells(outRow, outCol).Value = sInputRecord
         Loop
         Close #fNum
      
      End If
   Loop
   
errHandler:
   Reset 'close all file opened with the OPEN command
End Sub

 

[sanjeevkumargirdhar]

Hi Bertie,

Thanks for quick response. I tried this VB code, but after running no text data seen in excel sheet.

Sanjeev Girdhar

Hi, and welcome to the forum.

For future reference I would advise starting a new thread for your problem rather than reviving one that is one-year-old. By all means, feel free to send me a pm requesting I have a look if you feel I could help.

The code below allows you to open text files until you click Cancel on the dialogue box.
The output column starts at C=3, and increments by two for each input file.
Output row is initialize = 1, assumed header row.
Output sheet = "Sheet1".

Place the code in a standard module, Insert = > Module.

Option Explicit


Sub ImportTextFiels()
   Dim sInputFile As String
   Dim sInputRecord As String
   Dim bContinue As Boolean
   Dim outCol As Long
   Dim outRow As Long
   Dim fNum As Long


   outCol = 1
   bContinue = True
   On Error GoTo errHandler
   
   Do While bContinue = True
      outRow = 1
         
      sInputFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
      If sInputFile = "False" Then
         bContinue = False
         Reset 'close any opened text file
         Exit Sub
      
      Else
         outCol = outCol + 2
         
         'process text file
         fNum = FreeFile
         Open sInputFile For Input As #fNum
         
         Do While Not EOF(fNum)
            outRow = outRow + 1
            Line Input #fNum, sInputRecord
            Sheets("Sheet1").Cells(outRow, outCol).Value = sInputRecord
         Loop
         Close #fNum
      
      End If
   Loop
   
errHandler:
   Reset 'close all file opened with the OPEN command
End Sub

 

[bertie]

Do the text files you are testing the code on contain data?

Press F8 to step through the code one line at a time.
Hover your mouse over the variables to see if they contain values.
Post back your observations.

 

[sanjeevkumargirdhar]

Do the text files you are testing the code on contain data?

Press F8 to step through the code one line at a time.
Hover your mouse over the variables to see if they contain values.
Post back your observations.

File Data sample as below:

BRZVSS01.2 # show tech all
-> @@@ general:
@@@ general:
@@@
-> show version

Chassis : 800393-00-03 1114G-01557 Rev 3.0
Slot-1 :
Slot-2 :
Slot-3 :
Slot-4 :
Slot-5 :
Slot-6 : 800224-00-05 1120G-00342 Rev 5.0 BootROM: 1.0.4.0 IMG: 12.6.2.10
MSM-A : 800314-00-01 1048G-00976 Rev 1.0 BootROM: 1.0.4.4 IMG: 12.6.2.10
MSM-B : 800314-00-01 1111G-01846 Rev 1.0 BootROM: 1.0.4.4 IMG: 12.6.2.10
PSUCTRL-1 : 450306-00-03 1114G-01423 Rev 3.0 BootROM: 2.18
PSUCTRL-2 : 450306-00-03 1114G-01485 Rev 3.0 BootROM: 2.18
PSU-1 : PS 2350 4300-00146 1124J-01227 Rev 5.0
PSU-2 : PS 2350 4300-00146 1124J-01223 Rev 5.0
PSU-3 :
PSU-4 :
PSU-5 :
PSU-6 :

Image : ExtremeXOS version 12.6.2.10 v1262b10 by release-manager
on Thu Sep 29 18:28:32 EDT 2011
BootROM : 1.0.4.4
Diagnostics : 1.19
@@@
-> show version images
Card Partition Installation Date Version Name Branch
------------------------------------------------------------------------------
MSM-A primary Sat Oct 17 04:44:45 UTC 2009 12.3.3.6 aspen-12.3.3.6.xos v1233b6
MSM-A secondary Tue Feb 19 02:48:19 Congo 2013 12.6.2.10 bd8800-12.6.2.10.xos v1262b10
MSM-B primary Sat Oct 17 04:44:45 UTC 2009 12.3.3.6 aspen-12.3.3.6.xos v1233b6
MSM-B secondary Tue Feb 19 02:39:03 Congo 2013 12.6.2.10 bd8800-12.6.2.10.xos v1262b10


@@@
-> show switch

SysName: BRZVSS01
SysLocation: CONGO BRAZZA, BRAZZA_HQ
SysContact: Gerard Loussilaho: +242 055009285, Email: gerard.loussilaho@cg.airtel.com
System MAC: 00:04:96:52:5D:D9
System Type: BD-8806

SysHealth check: Enabled (Normal)
Recovery Mode: All
System Watchdog: Enabled

Current Time: Mon Apr 14 11:24:40 2014
Timezone: [Auto DST Disabled] GMT Offset: 60 minutes, name is Congo.
Boot Time: Tue Feb 19 02:54:15 2013
Boot Count: 5
Next Reboot: None scheduled
System UpTime: 419 days 8 hours 30 minutes 24 seconds

Slot: MSM-A * MSM-B
------------------------ ------------------------
Current State: MASTER BACKUP (In Sync)

Image Selected: secondary secondary
Image Booted: secondary secondary
Primary ver: 12.3.3.6 12.3.3.6
Secondary ver: 12.6.2.10 12.6.2.10

Config Selected: secondary.cfg secondary.cfg
Config Booted: secondary.cfg secondary.cfg

secondary.cfg Created by ExtremeXOS version 12.6.2.10
332696 bytes saved on Wed Apr 9 09:39:17 2014
@@@
-> show management
CLI idle timeout : Enabled (10 minutes)
CLI max number of login attempts : 3
CLI max number of sessions : 8
CLI paging : Disabled (this session only)
CLI space-completion : Disabled (this session only)
CLI configuration logging : Enabled
CLI scripting : Disabled (this session only)
CLI scripting error mode : Ignore-Error (this session only)
CLI persistent mode : Persistent (this session only)
CLI prompting : Disabled (this session only)
Telnet access : Enabled (tcp port 23 vr all)
: Access Profile : not set
SSH Access : ssh module not loaded.
Web access : Disabled (tcp port 80)
: Access Profile : not set
Total Read Only Communities : 1
Total Read Write Communities : 1
RMON : Disabled
SNMP access : Enabled
: Access Profile : not set
SNMP Traps : Enabled
SNMP v1/v2c TrapReceivers :
Destination Source IP Address Flags Timeout Retries
172.25.93.4 /162 10.200.12.1 2ET - -

Flags: Version: 1=v1 2=v2c
Mode: S=Standard E=Enhanced
Notification Type: T=Trap I=Inform

SNMP stats: InPkts 23479981OutPkts 23484505Errors 0 AuthErrors 1452
Gets 23454981GetNexts 23548 Sets 0 Drops 0
SNMP traps: Sent 5976 AuthTraps Enabled
SNMP inform: Sent 0 Retries 0 Failed 0
@@@
-> show fans

FanTray information:
State: Operational
NumFan: 6
PartInfo: 1114G-01500 450307-00-03
Revision: 3.0
Odometer: 754 days 14 hours 30 minutes since Mar-29-2011
Upper-Left Fan-1: Operational at 3060 RPM
Lower-Left Fan-2: Operational at 3060 RPM
Upper-Center Fan-3: Operational at 3000 RPM
Lower-Center Fan-4: Operational at 3000 RPM
Upper-Right Fan-5: Operational at 3000 RPM
Lower-Right Fan-6: Operational at 3000 RPM
@@@
-> show odometers
Service First Recorded
Field Replaceable Units Days Start Date
---------------------------------------------------------------
Chassis : BD-8806 754 Mar-29-2011
Slot-1 :
Slot-2 :
Slot-3 :
Slot-4 :
Slot-5 :
Slot-6 : G48Tc 754 May-27-2011
MSM-A : MSM-48c 754 Dec-03-2010
MSM-B : MSM-48c 754 Mar-17-2011
PSUCTRL-1 : 754 Mar-29-2011
PSUCTRL-2 : 754 Mar-29-2011
@@@
-> show temperature
Field Replaceable Units Temp (C) Status Min Normal Max
--------------------------------------------------------------------------
Slot-1 :
Slot-2 :
Slot-3 :
Slot-4 :
Slot-5 :
Slot-6 : G48Tc 31.00 Normal -10 0-50 60
MSM-A : MSM-48c 33.50 Normal -10 0-50 60
MSM-B : MSM-48c 33.00 Normal -10 0-50 60
PSUCTRL-1 : 34.32 Normal -10 0-50 60
PSUCTRL-2 : 28.42 Normal -10 0-50 60
@@@
-> ls
-rw-rw-rw- 1 root 0 334329 Jul 5 2013 primary.cfg
-rw-rw-rw- 1 root 0 332696 Apr 9 09:39 secondary.cfg
drwxrwxrwx 2 root 0 0 Feb 19 2013 vmt

1K-blocks Used Available Use%
16384 576 15808 4%
@@@
-> ls internal-memory
-rwxr-xr-x 1 root 0 149421 Apr 14 08:25 trace.devmgr.1275
-rwxr-xr-x 1 root 0 143174 Apr 14 08:25 trace.nodemgr.1281
-rwxr-xr-x 1 root 0 6544 Apr 14 08:25 trace.vlan.1293

1K-blocks Used Available Use%
49038 810 48228 2%
@@@
-> debug hal show compact-flash
Compact Flash and all filesystems appear normal
@@@
-> @@@ config:
@@@ config:
@@@
-> show config
#
# Module devmgr configuration.
#
configure snmp sysName "BRZVSS01"
configure snmp sysLocation "CONGO BRAZZA, BRAZZA_HQ"
configure snmp sysContact "Gerard Loussilaho: +242 055009285, Email: gerard.loussilaho@cg.airtel.com"
configure timezone name Congo 60 noautodst
configure slot 6 module G48Tc
configure sys-recovery-level slot 6 reset

#
# Module vlan configuration.
#
configure vlan default delete ports all
configure vr VR-Default delete ports 6:1-48
configure vr VR-Default add ports 6:1-48
configure vlan default delete ports 6:1-48
enable mirroring to port 6:40
create qosprofile "QP2"

 

[bertie]

I ran my code against the sample data and it worked fine at my end.
If you followed the instructions in post #6 and spotted nothing untoward then the only thing I can think of is the name of the output sheet. Edit this line:

Sheets("Sheet1").Cells(outRow, outCol).Value = sInputRecord

[edit]
Place the code in a standard module: Insert => Module.

 

[machominnow]

This script works for me, but can you give me the code to automatically open everything in the folder with the same extension? Also can it copy the file name into the top of the column?

Great help, I had researched this before but gave up, but yours works!

 

[ranisha]

Hello sir,
Is it possible to copy very long name text file in to workbook?

Could you please guide me
Thank you
rani

Hi, and welcome to the forum.

For future reference I would advise starting a new thread for your problem rather than reviving one that is one-year-old. By all means, feel free to send me a pm requesting I have a look if you feel I could help.

The code below allows you to open text files until you click Cancel on the dialogue box.
The output column starts at C=3, and increments by two for each input file.
Output row is initialize = 1, assumed header row.
Output sheet = "Sheet1".

Place the code in a standard module, Insert = > Module.

Option Explicit


Sub ImportTextFiels()
   Dim sInputFile As String
   Dim sInputRecord As String
   Dim bContinue As Boolean
   Dim outCol As Long
   Dim outRow As Long
   Dim fNum As Long


   outCol = 1
   bContinue = True
   On Error GoTo errHandler
   
   Do While bContinue = True
      outRow = 1
         
      sInputFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
      If sInputFile = "False" Then
         bContinue = False
         Reset 'close any opened text file
         Exit Sub
      
      Else
         outCol = outCol + 2
         
         'process text file
         fNum = FreeFile
         Open sInputFile For Input As #fNum
         
         Do While Not EOF(fNum)
            outRow = outRow + 1
            Line Input #fNum, sInputRecord
            Sheets("Sheet1").Cells(outRow, outCol).Value = sInputRecord
         Loop
         Close #fNum
      
      End If
   Loop
   
errHandler:
   Reset 'close all file opened with the OPEN command
End Sub