Import xls file into Excel using VBA

[Jay]

Hi all,

I'm positive someone can help me, because I've seen people hint at the
answer. Unfortunately, I just haven't found a code example.

I have an excel file that I'm writing a macro for. What I want to do is
have the user select a file (I used Application.getOpenFilename) and then the
macro will append the data from the selected file to the bottom of a specific
worksheet.

I tried using DAO objects to read the file, but I get error "3274: External
table is not in the expected format".
Code is:
Dim excelFile as DAO.Database
Set excelFile = OpenDatabase(FileName, False, False, "Excel 8.0;")
I'm not sure what could be the problem with the file, as it's just a
standard Excel file. I'm not aware of any issues with the data in the
worksheet.

If I was importing a CSV file, I could find lots of examples, but I'm
striking out with the excel to excel. If anyone can point me in the right
direction I'd appreciate it.

Thanks,
Jay

 

[Ron de Bruin]

Hi Jay

This tester start in
MyPath = "C:\Data"
Change that to your folder

And copy the range A1:C1 of the first worksheet to the first empty row in the first sheet in the workbook with the code
See also
http://www.rondebruin.nl/copy3.htm

Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim SourceRcount As Long
Dim N As Long
Dim rnum As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
MultiSelect:=True)
If IsArray(FName) Then
Application.ScreenUpdating = False
Set basebook = ThisWorkbook

For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))

rnum = LastRow(basebook.Worksheets(1)) + 1

Set sourceRange = mybook.Worksheets(1).Range("A1:C1")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
' This will add the workbook name in column D if you want

sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only the values

' With sourceRange
' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
' Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False

Next
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

 

[Jay]

Thanks very much Ron. It did almost exactly what I needed.

I needed to make a few changes to the code to get it to copy the entire data
range. Your code only copied the first line. I'll post my changes shortly.

Thanks again,
Jay