access vba 엑셀파일 가져오기
Public Function ImportFile(Filename As String, HasFieldNames As Boolean, tableName As String) As Boolean
' Example usage: call ImportFile ("Select an Excel File", "Excel Files", "*.xlsx", "C:\" , True,True, "ExcelImportTest", True, True,false,True)
Dim errCount As Integer
On Error GoTo err_handler
DoCmd.DeleteObject acTable, tableName
If (Right(Filename, 3) = "xls") Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tableName, Filename, HasFieldNames
Exit Function
ElseIf (Right(Filename, 4) = "xlsx") Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, tableName, Filename, HasFieldNames
Exit Function
End If
If (Right(Filename, 3) = "csv") Then
DoCmd.TransferText acLinkDelim, , tableName, Filename, True
End If
Exit_Thing:
'Clean up
'Check if our linked in Excel table already exists... and delete it if so
' If ObjectExists("Table", tableName) = True Then DropTable (tableName)
' If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tableName & "'")) Then
If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tableName & "'")) Then
DoCmd.DeleteObject acTable, tableName
End If
' Set colWorksheets = Nothing
Exit Function
err_handler:
If (Err.Number=3086 Or Err.Number=3274 Or Err.Number=3073) And errCount < 3 Then
errCount = errCount + 1
ElseIf Err.Number=3127 Then
MsgBox "The fields in all the tabs are the same. Please make sure that each sheet has the exact column names if you wish to import mulitple", vbCritical, "MultiSheets not identical"
ImportFile = False
GoTo Exit_Thing
Else
MsgBox Err.Number & "-" & Err.Description
ImportFile = False
GoTo Exit_Thing
Resume
End If
Resume
End Function
===================================
Private Sub ImportFile_Example()
Dim strXls As String
strXls = CurrentProject.Path & Chr(92) & "hometax_xlsxWriter.xlsx" 'xlsx파일
strXls = CurrentProject.Path & Chr(92) & "hometax_xlsxWriter.xls" 'xls파일
Call ImportFile(strXls, True, "Table1")
MsgBox "처리 완료"
End Sub