导入访问时动态设置表名

时间:2018-01-24 16:55:47

标签: excel vba ms-access

我有以下代码将Excel文件链接到Access 2016.但是,它会创建从文件名复制的表名。如何编辑代码以复制工作表名称并使用这些名称创建表。

像A.xls一样有表" A"和B.xlsm有工作表" B"。目前,它创建A.xls作为表名而不是A.

   Option Compare Database

   Option Explicit

   'code will link to excel and pull site files into access tables

   'Setting the path for the directory

    Sub LinkExcel()
    Dim iFile As String 'Filename
    Dim iFileList() As String 'File Array
    Dim intFile As Integer 'File Number

    Dim iPath As String

    iPath = "C:\Users\mchattopad004\Documents\Files\" 'Directory Path

   'Loop through the folder & build file list
    iFile = Dir(iPath & "*.xls")
    While iFile <> ""
    'add files to the list
    intFile = intFile + 1
    ReDim Preserve iFileList(1 To intFile)
    iFileList(intFile) = iFile
    iFile = Dir()
    Wend

   'see if any files were found
    If intFile = 0 Then
    MsgBox "No files found"
    Exit Sub
    End If

   'cycle through the list of files & link to Access
   For intFile = 1 To UBound(iFileList)
   DoCmd.TransferSpreadsheet acLink, , _
   iFileList(intFile), iPath & iFileList(intFile), True 
   Next

   MsgBox UBound(iFileList) & " Files were Linked"

  End Sub

1 个答案:

答案 0 :(得分:2)

这是您指定表名

的行
DoCmd.TransferSpreadsheet acLink, , _
iFileList(intFile), iPath & iFileList(intFile), True 'Set your range here.

第三个参数是TableName参数,因此将其更改为:

DoCmd.TransferSpreadsheet acLink, , _
Replace(Replace(iFileList(intFile), ".xlsm", ""), ".xls", ""), _
iPath & iFileList(intFile), True

那应该删除扩展名。