所以我多次使用doCmd.TransferText
来使用保存的文本导入规范,因为您可以轻松保存从Application.FileDialog(msoFileDialogFilePicker)
返回的文件路径,以查找您要导入的文件。保存的规范。
但是我无法找到使用excel文件执行相同操作的方法,保存excel导入规范很简单,但使用DoCmd.TransferSpreadSheet
方法无法使用已保存的导入,如使用doCmd.RunSavedImportExport
没有选择指定文件路径。
除了使用不同的文件类型(例如.csv)
之外,还有其他解决方法吗?答案 0 :(得分:9)
"保存进口"和#34;保存的出口"在Access中存储在ImportExportSpecification
个对象中,形成CurrentProject.ImportExportSpecifications
集合。保存的Excel导入的详细信息类似于以下XML,我通过手动导入Excel电子表格并勾选"保存导入步骤"来创建。导入向导的最后一页上的复选框。
<?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>
使用名称Import-xlsxTest
保存ImportExportSpecification。现在,如果我从&#34; xlsxTest.xlsx&#34;重命名Excel文件to&#34; anotherTest.xlsx&#34;我可以使用以下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
有关ImportExportSpecification
个对象的更多信息,请参阅
答案 1 :(得分:3)
看到这一点,并认为我分享了一段时间以后解决问题的事情。更多地控制规范中可以更改的内容:
' MSXML2 requires reference to "Microsoft XML, v6.0"
' earlier versions are probably compatible, remember to use the appropriate DOMDocument object version.
Sub importExcelFile(ImportSpecName As String, Filename As String, SheetName As String, OutputTableName As String)
Dim XMLData As MSXML2.DOMDocument60
Dim ImportSpec As ImportExportSpecification
Dim XMLNode As IXMLDOMNode
' Get XML object to manage the spec data
Set XMLData = New MSXML2.DOMDocument60
XMLData.async = False
XMLData.SetProperty "SelectionLanguage", "XPath"
XMLData.SetProperty "SelectionNamespaces", "xmlns:imex='urn:www.microsoft.com/office/access/imexspec'"
' need to rename the default namespace, so that we can XPath to it. New name = 'imex'
' existing Import Specification (should be set up manually with relevant name)
Set ImportSpec = CurrentProject.ImportExportSpecifications(ImportSpecName)
XMLData.LoadXML ImportSpec.XML
' change it's path to the one specified
With XMLData.DocumentElement
.setAttribute "Path", Filename
' Destination attribute of the ImportExcel node
Set XMLNode = .SelectSingleNode("//imex:ImportExcel/@Destination") ' XPath to the Destination attribute
XMLNode.Text = OutputTableName
' Range attribute of the ImportExcel node
Set XMLNode = .SelectSingleNode("//imex:ImportExcel/@Range") ' XPath to the range attribute
XMLNode.Text = SheetName & "$"
End With
ImportSpec.XML = XMLData.XML
' run the updated import
ImportSpec.Execute
End Sub
答案 2 :(得分:2)
我研究了同样的问题。 Gord发布的解决方案给了我一个XML解释错误。 Cosmichighway发布了这个解决方案:http://www.utteraccess.com/forum/index.php?showtopic=1981212。
此解决方案适用于Access 2010和Access 2013,并且也适用于Access 2007.
With CurrentProject.ImportExportSpecifications("nameOfSpecification")
debug.print .XML
.XML = Replace(.XML, varSavedPathName, varNewPathName)
debug.print .XML
End With
我为每个导出生成一个唯一的文件名,因此一旦完成该过程,我就会恢复原始文件名路径。 WorkHoursTransactions是一个常量。例如:
CONST ConstExportSavedPathName="c:\temp\Name Of File To Use.xls"
tmpFileName = WorkHoursTransactions & ";" & Format(Now(), "YYYYMMDD-HHMMSS") & ".xls"
With CurrentProject.ImportExportSpecifications(WorkHoursTransactions)
.XML = Replace(.XML, ConstExportSavedPathName, tmpFileName)
'Debug.Print .XML
End With
DoCmd.OpenReport WorkHoursTransactions, acViewReport, , , acWindowNormal
DoCmd.RunSavedImportExport WorkHoursTransactions
' return to original filename
With CurrentProject.ImportExportSpecifications(WorkHoursTransactions)
.XML = Replace(.XML, tmpFileName, ConstExportSavedPathName)
'Debug.Print .XML
End With
我也遇到了这个很好的提示,使用立即窗口来显示XML。如果您有一个名为&#39; Export-Table1&#39;的导出规范,那么您可以将其粘贴到即时窗口中以查看XML:
? CurrentProject.ImportExportSpecifications.Item("Export-Table1").XML
答案 3 :(得分:0)
就我而言
vbCrLf 无效 - 但 vbLF 确实有效!
我正在使用Access 2010(32位)。
Stefan的问候
答案 4 :(得分:0)
要添加@Alberts答案,如果我们将当前文件路径作为常量,那么,当我们下次运行代码时(例如,用户决定在一段时间之后将excel文件存储在不同的文件夹中) ,&#39;替换&#39;函数将找不到搜索文本,因为在第一次运行中路径已更改。因此,为了使其成为动态的,我们只需要在将其替换为新路径时将当前文件路径写入表中。在&#39;替换&#39;函数,我们只是引用这个值。文件路径没有硬编码。
Let Current File Path = DLookup("[Current file path]", "File Path Table")
Let New File Path = DLookup("[New file path]", "File Path Table")
With CurrentProject.ImportExportSpecifications("Saved-Export")
.XML = Replace(.XML, Current File Path, New File Path)
End With
DoCmd.RunSavedImportExport Saved-Export
'Now you write the 'new file path' to the 'current file path' field in the table
Set mydb = DBEngine.Workspaces(0).Databases(0)
Set myset = mydb.OpenRecordset("File Path Table")
myset.Edit
Let myset![Current file path] = New File Path
myset.Update
myset.Close
Set myset = Nothing
Set mydb = Nothing
所以下次运行时,它会选择要替换的正确当前文件。