Multiple files imported to specified tabs script

[lorcav]

Scenario:
I have a template file that i use alot. Normally i have to import several text files into the tabs on the spreadsheet. These text files are the output of another system and though the file name changes there is a consistent 2 letter code at the end of each file that corresponds to a tab on the template. The template has specific column headers on each tab and i normally have to manually enter the data on each tab from each text file using import data and text to columns into cell A2

Question
Can a VB/VBA script be written that would give me a dialogue window that would allow me to specify txt files on my hard drive, which sheet to import them to and what delimiter to use (almost always commas) and format of the cells (always text)?

Any help would be very appreciated.

[p45cal]

Looking at a couple of your data (text) files, they seem to be the export of some database, having the same header information as your corresponding sheets in the workbook. This may lend itself to grabbing the data with a query of these text files rather than an import.
So first question is do you always import to a blank sheet (save for the headers) or do you ADD data each time, so that the sheet gradually gets bigger at each import?

If the answer is that you only import to a blank sheet each time, then a query can confer a few advantages:
It's easy in VBA to change the file that is queried.
Some automation could be applied which would recognise which file needs to be queried for each sheet - you might only have to point it to which folder the files are in.
If you don't want to import all the columns, but only a selection of them, this is easy, even if the columns don't happen to be in the right order in the text file (this also means that you can have the columns appear in the order you want to see them in easily).
You may not want to import all the rows of data (records), again it's generally easy to set up the query to import only those records you need.
Another possibility is that the query can include summary information and/or sort the data.
If you're interested, it's QueryTables I'm talking about and once the file they query has been pointed to, it's just a case of 'refreshing' the query, which retains all the formats of each column, the sort order (both of the columns and the rows), the filter, any summary info, whether the file is comma delimited or something else delimited etc. etc.

This is only easy if you're importing to a sheet where you don't want to keep old data.

[rbrhodes]

Hi lorcav,

Welcome to VBX. Here's a go at it.

Although I could have got you to hard code a path into the code I choose versatility over convenience. By which I mean you have to click a button!

The code will ask you "Yes for multiple files or No for chosen file." Whether you choose yes or no you are then prompted to click on a file name in a Dialog box.

Now, if you chose "No" when asked, only the file you click on will be loaded. If you choose "Yes" when asked, ALL *.txt files in that directory will be loaded.

The inconvenience is having to answer that 1 question, the versatility is that you get to choose where the filea are from and 1 or all. ie: ANY Drive/Directory/Subdirectory you choose a file from will be used. 1 file at a time or all at once, your choice.

I could change it so it's always the same (and only one) Drive\Directory etc. still leaving it as one file or many. Up to you.

Only question I had was delete old data or append? I choose delete old. Again, your call.

Let me know...

[EDIT] Replaced attachment with New file/New code as per next post

[lorcav]

Hi to you both, thanks for your responses.

@P45cal
Each time the text files are outputted they go onto the template which is then saved with a certain name. So basically it is always adding the data, never overwriting existing data or appending data.

@rbrhodes
Thanks again for your attachment it's pretty much exactly what i've been aiming for, if you could just advise me on one other adjustment. The data needs to be imported as text rather general/number. This is because some of the identifiers (always 6 digit codes) start with zeroes. This means that, like in the test text files, 000333 becomes 333. What can i add in to resolve this?

Thanks(again) in advance.

[p45cal]

I've just taken a peep at rbrhodes code, and it looks as if it only takes the first 58 columns of each text file, and there are 3 with more than this, (including data in them) - one has 248 columns.
Since the column data types are not in a consistent order across all sheets, it's going to be difficult to have a one-size-fits-all import method for the different files. I note also that there are some American style dates - I'd thought it would be better to have these held as dates proper, in Excel.

I was surprised that you're needing to use the Text to Columns tool. What version of Excel are you using?

When I tried importing text files I went, from the dropdown menus,:
Data|Import External Data|Import Data..
In the Files of type field at the bottom, I chose Text Files,
navigated to the folder, selected the appropriate file according to which sheet I was on, clicked Open, and was presented with the Text Import Wizard which allowed me to do all the usual stuff, choose comma delimited, choose how to import each column, setting text, general and even the kind of date, even allowing me to skip columns etc. etc. Then it asked me where I wanted to put the data (A2) and I finished the process.
At this stage I had a repeat of the column headers, so I copied the formatting of lorcav's top row to the 2nd row and removed Row 1 altogether.
Now, I discovered that I had a query on the sheet, and it could be refreshed and it would retain all the settings I'd chosen: Select any cell in the table (A1), and if the External Table toolbar isn't already visible, make it so by:
View|Toolbars|External Data
and click the exclamation mark on it.
It then presented me with a dialogue box to navigate to a file, but the previously used file was already selected, I clicked on the Import button and that was it.
Manually it wouldn't be too hard to do this for every sheet, but this phase could be automated too.

Is this a route you might want to go down?
(I'm using XL 2003 btw.)

[rbrhodes]

Hi lorcav,

I've updated the attachment on my previous post. Same name but it has this new code in it/

Here's the sub rewritten:

Re: the width of the post. VBA was choking on "too many line separators"


- I corrected the spelling of "Ameties" in the Select Case routine.

- Replaces the Import array with one that extends to 256 Columns

- Changed the import to format all as text...

Either delete the whole sub (not the Functions!!) and replace it with this.

Or correct the spelling mistake, Delete the Import section and replace it with the one from here.


Option Explicit
Sub ImportTxt()
Dim mult(9) '10 files?
Dim i As Long
Dim msg As Long
Dim Lastrow As Long
Dim dName As String
Dim fName As String
Dim pthName As String
Dim shtName As String
Dim SaveName As String
Dim CopyTo As Worksheet
Dim MoreThan1 As Boolean
Dim wbDestination As Workbook
'Speed/Recursion
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Copy to
Set wbDestination = ThisWorkbook
'Handle
'On Error GoTo endo

'Ask user
msg = MsgBox("Click Yes to Import all files." & vbCrLf & vbCrLf & _
"Click No to import chosen file only.", vbQuestion + vbYesNo, "One file or many?")

If msg = 6 Then MoreThan1 = True

'Get text file
fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")

'User Cancelled
If fName = "False" Then
GoTo endo
End If
'Extract pathname for multiple
If MoreThan1 = True Then
pthName = ExtractPathName(fName)
'Get the names of all .txt files in the specified directory
On Error Resume Next
dName = Dir(pthName & "*.txt", vbDirectory)
Do While (Len(dName) > 0)
' See if we should skip this file.
If Not (dName = ".") Or (dName = "..") Then
mult(i) = dName
i = i + 1
End If
' Get the next file.
dName = Dir()
Loop
'Decr
i = i - 1
'Get last file name
fName = mult(i)
End If
ReturnMult:
'Get matching extension
shtName = Mid(fName, Len(fName) - 6, 2)
'Choose
Select Case shtName
Case Is = "PB"
shtName = "Property Basic (PB)"
Case Is = "CS"
shtName = "Client Specific (CS)"
Case Is = "SA"

'//Corrected spelling of "Amenties"

shtName = "Service & Amenities (SA)"
Case Is = "SS"
shtName = "Safety & Security (SS)"
Case Is = "GT"
shtName = "Geography & Transportation (GT)"
Case Is = "CT"
shtName = "Communication (CT)"
Case Is = "ES"
shtName = "Extended Stay (ES)"
Case Is = "GM"
shtName = "General Meetings (GM)"
Case Is = "CM"
shtName = "Client Specific Meetings (CM)"
Case Else
End Select

'//Replaced to handle 256 Columns

Workbooks.OpenText Filename:=fName, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1), Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1), Array(72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78, 1), Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1), Array(85, 1), Array(86, 1), Array(87, 1), Array(88, 1), _
Array(89, 1), Array(90, 1), Array(91, 1), Array(92, 1), Array(93, 1), Array(94, 1), Array(95, 1), Array(96, 1), Array(97, 1), Array(98, 1), Array(99, 1), Array(100, 1), Array(101, 1), Array(102, 1), Array(103, 1), Array(104, 1), Array(105, 1), Array(106, 1), Array(107, 1), Array(108, 1), Array(109, 1), Array(110, 1), Array(111, 1), Array(112, 1), Array(113, 1), Array(114, 1), Array(115, 1), Array(116, 1), Array(117, 1), Array(118, 1), Array(119, 1), Array(120, 1), Array(121, 1), Array(122, 1), Array(123, 1), Array(124, 1), Array(125, 1), Array(126, 1), Array(127, 1), Array(128, 1), Array(129, 1), Array(130, 1), Array(131, 1), Array(132, 1), Array(133, 1), Array(134, 1), Array(135, 1), Array(136, 1), Array(137, 1), Array(138, 1), Array(139, 1), Array(140, 1), _
Array(141, 1), Array(142, 1), Array(143, 1), Array(144, 1), Array(145, 1), Array(146, 1), Array(147, 1), Array(148, 1), Array(149, 1), Array(150, 1), Array(151, 1), Array(152, 1), Array(153, 1), Array(154, 1), Array(155, 1), Array(156, 1), Array(157, 1), Array(158, 1), Array(159, 1), Array(160, 1), Array(161, 1), Array(162, 1), Array(163, 1), Array(164, 1), Array(165, 1), Array(166, 1), Array(167, 1), Array(168, 1), Array(169, 1), Array(170, 1), Array(171, 1), Array(172, 1), Array(173, 1), Array(174, 1), Array(175, 1), Array(176, 1), Array(177, 1), Array(178, 1), Array(179, 1), Array(180, 1), Array(181, 1), Array(182, 1), Array(183, 1), Array(184, 1), Array(185, 1), Array(186, 1), Array(187, 1), Array(188, 1), Array(189, 1), Array(190, 1), Array(191, 1), Array(192, 1), _
Array(193, 1), Array(194, 1), Array(195, 1), Array(196, 1), Array(197, 1), Array(198, 1), Array(199, 1), Array(200, 1), Array(201, 1), Array(202, 1), Array(203, 1), Array(204, 1), Array(205, 1), Array(206, 1), Array(207, 1), Array(208, 1), Array(209, 1), Array(210, 1), Array(211, 1), Array(212, 1), Array(213, 1), Array(214, 1), Array(215, 1), Array(216, 1), Array(217, 1), Array(218, 1), Array(219, 1), Array(220, 1), Array(221, 1), Array(222, 1), Array(223, 1), Array(224, 1), Array(225, 1), Array(226, 1), Array(227, 1), Array(228, 1), Array(229, 1), Array(230, 1), Array(231, 1), Array(232, 1), Array(233, 1), Array(234, 1), Array(235, 1), Array(236, 1), Array(237, 1), Array(238, 1), Array(239, 1), Array(240, 1), Array(241, 1), Array(242, 1), Array(243, 1), Array(244, 1), _
Array(245, 1), Array(246, 1), Array(247, 1), Array(248, 1), Array(249, 1), Array(250, 1), Array(251, 1), Array(252, 1), Array(253, 1), Array(254, 1), Array(255, 1), Array(256, 1))


'//End

'Get last row of imported data
Lastrow = Range("A" & Rows.Count).End(xlUp).Row

'Delete old??
With wbDestination.Sheets(shtName)
.Range("A2:BF" & Rows.Count).ClearContents
'Copy to sheet: Range A2 till above is answered
ActiveSheet.Range("A2:BF" & Lastrow).Copy .Range("A2")
End With

'Kill text file
ActiveWorkbook.Close False

'Check if multiple
If MoreThan1 = True Then
'Decr
i = i - 1
'check if done
If i > -1 Then
fName = mult(i)
GoTo ReturnMult
End If
End If
'Reset
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Cleanup
Set CopyTo = Nothing
Set wbDestination = Nothing
'Completed normally
Exit Sub

'Errored out
endo:
'Reset
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Cleanup
Set CopyTo = Nothing
Set wbDestination = Nothing
'Inform user
msg = MsgBox("Error " & Err.Number & ". " & Err.Description, vbCritical, " Errored out")
End Sub