VBA Code to Import Excel Files

[Rxp]

How to write VBA code to import excel files into a table in Access with a click of a button? The excel file and access table has same column name.

[Rxp]

I found it:




Private Sub Command0_Click()

' This subprocedure determines whether
' any Excel files exist in the folder stored
' in the strcPath constant; if there are,
' this subprocedure imports the data in the
' Excel files and then moves the files to
' the folder stored in the strcNewPath constant.


' Store paths:
Const strcPath As String = _
"C:\Users\rxp\Desktop\Excel\"
Const strcNewPath As String = _
"C:\Users\rxp\Desktop\Excel1\"

' Store the name of the table into which
' the data will be imported
Const strcTableName As String = "Table1"

Dim strPath As String
Dim strNewPath As String
Dim strFile As String
Dim strFileList() As String
Dim intFile As Integer
Dim strFullPath As String
Dim strFullNewPath As String


' See if path constant ends in a backslash:
If Right(strcPath, 1) = "\" Then
strPath = strcPath
Else
strPath = strcPath & "\"
End If

' See if new path constant ends in a backslash:
If Right(strcNewPath, 1) = "\" Then
strNewPath = strcNewPath
Else
strNewPath = strcNewPath & "\"
End If


' Loop through the Excel files in the folder
' (if any) and build file list:
strFile = Dir(strPath & "*.xlsx")
While strFile <> ""
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend


' See if any files were found:
If intFile = 0 Then

MsgBox strcPath & vbNewLine & vbNewLine _
& "The above directory contains no Excel " _
& "files.", _
vbExclamation + vbOKOnly, "Program Finished"

GoTo Exit_Import_From_Excel

End If


' Loop through the list of files:
For intFile = 1 To UBound(strFileList)

' Initialise paths:
strFullPath = strPath & strFileList(intFile)
strFullNewPath = strNewPath & strFileList(intFile)

' Import into Access:
DoCmd.TransferSpreadsheet acImport, _
acSpreadsheetTypeExcel97, strcTableName, _
strFullPath, True

' Copy file to new location:
FileCopy strFullPath, strFullNewPath

' Delete old file:
Kill strFullPath

Next

MsgBox UBound(strFileList) & " file(s) were imported", _
vbOKOnly + vbInformation, "Program Finished"

Exit_Import_From_Excel:


Exit Sub

End Sub

[Kimbertha]

This worked for me! Unfortunately myclient's workbook has Instructions on the first tab and that is what gets imported.

How do I specify a tab and a range within that tab?
What is the syntax to link a file rather than import?

I am a VBA noob so I don't have a clue on this.

I found it:




Private Sub Command0_Click()

' This subprocedure determines whether
' any Excel files exist in the folder stored
' in the strcPath constant; if there are,
' this subprocedure imports the data in the
' Excel files and then moves the files to
' the folder stored in the strcNewPath constant.


' Store paths:
Const strcPath As String = _
"C:\Users\rxp\Desktop\Excel\"
Const strcNewPath As String = _
"C:\Users\rxp\Desktop\Excel1\"

' Store the name of the table into which
' the data will be imported
Const strcTableName As String = "Table1"

Dim strPath As String
Dim strNewPath As String
Dim strFile As String
Dim strFileList() As String
Dim intFile As Integer
Dim strFullPath As String
Dim strFullNewPath As String


' See if path constant ends in a backslash:
If Right(strcPath, 1) = "\" Then
strPath = strcPath
Else
strPath = strcPath & "\"
End If

' See if new path constant ends in a backslash:
If Right(strcNewPath, 1) = "\" Then
strNewPath = strcNewPath
Else
strNewPath = strcNewPath & "\"
End If


' Loop through the Excel files in the folder
' (if any) and build file list:
strFile = Dir(strPath & "*.xlsx")
While strFile <> ""
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend


' See if any files were found:
If intFile = 0 Then

MsgBox strcPath & vbNewLine & vbNewLine _
& "The above directory contains no Excel " _
& "files.", _
vbExclamation + vbOKOnly, "Program Finished"

GoTo Exit_Import_From_Excel

End If


' Loop through the list of files:
For intFile = 1 To UBound(strFileList)

' Initialise paths:
strFullPath = strPath & strFileList(intFile)
strFullNewPath = strNewPath & strFileList(intFile)

' Import into Access:
DoCmd.TransferSpreadsheet acImport, _
acSpreadsheetTypeExcel97, strcTableName, _
strFullPath, True

' Copy file to new location:
FileCopy strFullPath, strFullNewPath

' Delete old file:
Kill strFullPath

Next

MsgBox UBound(strFileList) & " file(s) were imported", _
vbOKOnly + vbInformation, "Program Finished"

Exit_Import_From_Excel:


Exit Sub

End Sub