Format number as text on multiple files import to a Single Workbook

  • Thread starter Thread starter avi
  • Start date Start date
Hi,

Not tested but add these 2 lines to the code

wkbTemp.Close (False)' Existing line
wkbAll.Worksheets(x).Cells.NumberFormat = "@" 'New line

and here

With wkbAll 'Existing line
.Worksheets(x).Cells.NumberFormat = "@" 'New line
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.
 
Well thanx Joel for your effort but
this should work
Click to expand...
unfortunately it appears not to be working: "Subscript out of range"
error ; imports only last file selected not all of them; does not
format number as text: I have lost my leading zeros and cell
properties reads "General" (on 1 imported file).
 
Well thanx Mike for your effort but
unfortunately it appears not to be working:
"Subscript out of range" error ; does not import all the selected
files into one workbook but only 2 of the selected & into 2 workbooks
one of which has cells format as text but still I have lost my leading
zeros.
 
Joel,

When running your last code there is error: "Object variable with
Block variable not set." and code is interrupted, nothing happens.
 
after a while, here's the modified solution code:
----------

'http://excel.tips.net/Pages/
T003148_Importing_Multiple_Files_to_a_Single_Workbook.html

Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = "|"

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

x = 1
' Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) *** below is
forced text format

Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x),
Format:=xlTextFormat)


wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns , _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:= _
xlNone, ConsecutiveDelimiter:=False, Tab:=True,
Semicolon:=False, Comma _
:=False, Space:=False, Other:=False, OtherChar:="|", _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2),
Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2),
Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2),
Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2),
Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2),
Array(25, 2), Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2),
Array(30, 2), 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, 9))

' **** array forcing text format (2)



x = x + 1

While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
With wkbAll
wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns , _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:= _
xlNone, ConsecutiveDelimiter:=False, Tab:=True,
Semicolon:=False, Comma _
:=False, Space:=False, Other:=False, OtherChar:="|", _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2),
Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2),
Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2),
Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2),
Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2),
Array(25, 2), Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2),
Array(30, 2), 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, 9))

' **** array forcing text format (2) although seems not
necessary


End With
x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
----------------------------------------------------
 
Back
Top