如何为已保存的Excel导入指定其他文件路径

peg*_*ity 10 ms-access vba access-vba

所以我doCmd.TransferText多次使用保存的文本导入规范,因为您可以轻松保存从Application.FileDialog(msoFileDialogFilePicker)a 返回的文件路径,以查找要使用保存的规范导入的文件.

但是我无法找到使用excel文件执行相同操作的DoCmd.TransferSpreadSheet方法,保存excel导入规范很简单,但使用该方法无法使用已保存的导入,并且使用doCmd.RunSavedImportExport没有选项来指定文件路径.

除了使用不同的文件类型(例如.csv)之外,还有其他解决方法吗?

Gor*_*son 9

Access中的"Saved Imports"和"Saved Exports"存储在ImportExportSpecification构成CurrentProject.ImportExportSpecifications集合的对象中.保存的Excel导入的详细信息类似于以下XML,我通过手动导入Excel电子表格并勾选导入向导最后一页上的"保存导入步骤"复选框创建了该XML.

<?xml version="1.0" encoding="utf-8" ?>
<ImportExportSpecification Path = "C:\Users\Gord\Desktop\xlsxTest.xlsx" xmlns="urn:www.microsoft.com/office/access/imexspec">
     <ImportExcel FirstRowHasNames="true" Destination="xlsxTest" Range="Sheet1$" >
            <Columns PrimaryKey="ID">
                  <Column Name="Col1" FieldName="ID" Indexed="YESNODUPLICATES" SkipColumn="false" DataType="Long" />
                  <Column Name="Col2" FieldName="TextField" Indexed="NO" SkipColumn="false" DataType="Text" />
                  <Column Name="Col3" FieldName="DateField" Indexed="NO" SkipColumn="false" DataType="DateTime" />
             </Columns>
        </ImportExcel>
</ImportExportSpecification>
Run Code Online (Sandbox Code Playgroud)

ImportExportSpecification已使用名称保存Import-xlsxTest.现在,如果我将Excel文件从"xlsxTest.xlsx"重命名为"anotherTest.xlsx",我可以使用以下VBA代码更改ImportExportSpecification的XML中的文件名,然后执行导入:

Option Compare Database
Option Explicit

Sub DoExcelImport()
    Dim ies As ImportExportSpecification, i As Long, oldXML() As String, newXML As String

    Const newXlsxFileSpec = "C:\Users\Gord\Desktop\anotherTest.xlsx"  ' for testing

    Set ies = CurrentProject.ImportExportSpecifications("Import-xlsxTest")
    oldXML = Split(ies.XML, vbCrLf, -1, vbBinaryCompare)
    newXML = ""
    For i = 0 To UBound(oldXML)
        If i = 1 Then  
            ' re-write the second line of the existing XML
            newXML = newXML & _
                    "<ImportExportSpecification Path = """ & _
                    newXlsxFileSpec & _
                    """ xmlns=""urn:www.microsoft.com/office/access/imexspec"">" & _
                    vbCrLf
        Else
            newXML = newXML & oldXML(i) & vbCrLf
        End If
    Next
    ies.XML = newXML
    ies.Execute
    Set ies = Nothing
End Sub
Run Code Online (Sandbox Code Playgroud)

有关ImportExportSpecification对象的更多信息,请参阅

ImportExportSpecification对象(Access)