Please Help- Importing multiple files

Randi8484

New Member
Joined
Apr 11, 2014
Messages
1
I have multiple files that I want to import into the same spreadsheet. The files are extension .asc but import as text, tab delimited, two columns wide. I want to then perform a -log() function on the second column. Then I want to plot the first column and the -log result.

I need to import row 57 after "DATA" to the end, in two columns.
The raw data files look like this:

PE IR SPECTRUM ASCII PEDS 1.60
-1
DUMMY.ASC
12/05/30
19:08:49.00
12/05/30
19:08:50.00
OELCHECK
ReferenceSpectrum = PerkinElmer
450.000000
4


















SPECTRUM 400,CPU32 MAIN 00.09.9932 04-NOVEMBER-2009 13:58:07
MIR TGS
MIR
OPTKBR
86121
0.200000


4.000000
STARK
PROBE:
SPEKTRUM
MAGNITUDE
SHUTTLE
DOUBLE


COMBINED




0




#HDR
-1
-1
#GR
CM-1
%T
0.00002384185791015625
0.0
4000.000000
-1.000000
3551
8
58.613713
0.000456
#DATA
4000.000000 52.179804
3999.000000 52.218992
3998.000000 52.259096
etc...




I pieced this together by recording a macro and some steps found on other message boards, but I'm getting an error on the import step (highlighted in bold). The error is "Run-time error '1004': Application-defined or object defined error". Please help.



Sub Randi2()
'
' Randi2 Macro
'
Dim msg As String
Dim targetDir As String
Dim fileDescrip As String
Dim fName As String


'
msg = "Enter full path of directory where files " & _
"are to be found." & _
Chr(13) & "Example: C:\EXCEL" 'Chr(13) tabs to the next line
targetDir = Trim(InputBox(msg))
If targetDir = "" Then Exit Sub


If Right(targetDir, 1) = "\" Then
targetDir = Left(targetDir, Len(targetDir) - 1)
End If


ChDrive Left(targetDir, 1)


'display input box to get the file pattern for files to be opened
'Store input in variable fileDescrip
msg = "Enter the pattern for files to be opened." & _
Chr(13) & "Example: Book*.xls"
fileDescrip = Trim(InputBox(msg))
If fileDescrip = "" Then Exit Sub
'get first file (not necessarily in alphabetical order)
fName = Dir(targetDir & "\" & fileDescrip)
If Right(targetDir, 1) = "\" Then
targetDir = Left(targetDir, Len(targetDir) - 1)
End If
'if file found, open it and loop back and open other files
'Use on error to catch error if file can't be opened
Do
Range("B1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
fName, Destination:= _
Range("$B$1"))
.Name = "2233253_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 57
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "=-LOG(RC[-1])"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D3551")
Range("D1:D3551").Select
Columns("C:C").Select
Columns("D:D").Select
Selection.Copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("C1").Select


fName = Dir()
Loop Until fName = ""


End Sub
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,432
Office Version
  1. 2013
Platform
  1. Windows
I think that this:
Code:
fName = Dir(targetDir & "\" & fileDescrip)
If Right(targetDir, 1) = "\" Then
targetDir = Left(targetDir, Len(targetDir) - 1)
Should be this:
Code:
If Right(targetDir, 1) <> "\" Then
targetDir = targetDir & "\"
fName = Dir(targetDir & fileDescrip)
.
Then I would Change this:
Code:
Range("B1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
fName, Destination:= _
Range("$B$1"))
To this:
Code:
With ActiveSheet.QueryTables.Add(Connection:= _
fName, Destination:=Range("$B$1"))
You don't need the Range("B1").Select. You tell it that B1 is the destination.
Outside of those two nits, I don't see any furry hands in the code. With the Application Defined or Object defined error, it could be incorrectly spelled words or a variable glitch or an out of place character like a comma for a period of vice versa. You would have to analyze each step of your code, if the cause is not obvious in the line that is highlighted.
 

Watch MrExcel Video

Forum statistics

Threads
1,108,939
Messages
5,525,739
Members
409,661
Latest member
pprabha

This Week's Hot Topics

Top