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
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
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.
 
Upvote 0

Forum statistics

Threads
1,214,788
Messages
6,121,597
Members
449,038
Latest member
Arbind kumar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top