修改MS ACCESS ImportExportSpecifications

时间:2014-11-23 23:48:46

标签: ms-access access-vba ms-access-2010

我正在尝试导入两个非常相似但在我的数据库中进入不同表的文本文档。我参考了How can I modify a saved Microsoft Access 2007 or 2010 Import Specification?引用的解决方案,这有助于我到达现在的位置。我有2个已保存的导入规格,每个文件一个,但我无法指定导入文件时我尝试修改的规范。该代码适用于拾取的文件,但我看不到要修改第二个导入规范的代码。第一个规范是“opt”文件,第二个是“recip”文件。我错过了什么吗?

On Error GoTo ERR_Handler:
    Dim mySpec As ImportExportSpecification
    Dim myNewSpec As ImportExportSpecification
    Dim y As Integer, x As Date
    Dim myDir As String, fn As String, a(), n As Long
    Dim RecentFile As String, myDate As Date, temp As Date, strData As String

    myDir = "\\Text Files"
    fn = Dir(myDir & "\Op?" & ".txt") 'Change to myDir & "\XX?" & ".txt" for each file
    x = Date

Do While fn <> ""
temp = CreateObject("Scripting.FileSystemObject").GetFile(myDir & "\" & fn).DateLastModified
   If myDate = 0 Then
      myDate = temp: RecentFile = myDir & "\" & fn
Else
   If myDate < temp Then myDate = temp: RecentFile = myDir & "\" & fn
End If
fn = Dir

Loop

    For y = 0 To CurrentProject.ImportExportSpecifications.Count - 1
    If CurrentProject.ImportExportSpecifications.Item(y).Name = "TemporaryImport" Then
    CurrentProject.ImportExportSpecifications.Item("TemporaryImport").Delete
    y = CurrentProject.ImportExportSpecifications.Count
End If
Next y
    Set mySpec = CurrentProject.ImportExportSpecifications.Item(myTempTable)
    CurrentProject.ImportExportSpecifications.Add "TemporaryImport", mySpec.XML
    Set myNewSpec = CurrentProject.ImportExportSpecifications.Item("TemporaryImport")

    myNewSpec.XML = Replace(myNewSpec.XML, "RecentFile", myPath)
    myNewSpec.Execute
    myNewSpec.Delete
    Set mySpec = Nothing
    Set myNewSpec = Nothing
exit_ErrHandler:
    For y = 0 To CurrentProject.ImportExportSpecifications.Count - 1
    If CurrentProject.ImportExportSpecifications.Item(y).Name = "TemporaryImport" Then
        CurrentProject.ImportExportSpecifications.Item("TemporaryImport").Delete
        y = CurrentProject.ImportExportSpecifications.Count
    End If
    Next y
Exit Sub
ERR_Handler:
MsgBox Err.Description
Resume exit_ErrHandler
End Sub

上面的代码对于“recip”文件是相同的,fn = Dir(myDir & "\Op?" & ".txt")除外,它被更改为fn = Dir(myDir & "\recip?" & ".txt")。请帮忙。谢谢。

1 个答案:

答案 0 :(得分:0)

不确定你要做什么,但我猜你试图导入文本文件保存步骤并使用保存的模板导入其他文件?

所以逻辑上你的代码应该是这样的:

  1. 执行导入(附加数据)
  2. 保存步骤
  3. 循环浏览要导入的其他文件
  4. 更改savedTemplate
  5. 中的文件路径
  6. 导入文件&gt;执行此操作直到导入所有文件。
  7. 在代码中它将是:

    With CurrentProject.ImportExportSpecifications("ImportSection-95")
    
        mSelectedFile = "" 'C:\mytext.txt  or your loop to get the file path..
    
        If Nz(mSelectedFile, "") = "" Then
            MsgBox "! You haven't selected any file this event will be cancelled", vbExclamation, "No source file selected"
            Exit Sub
        End If
    
       'Modify the xml path
        Dim mStart_pos, mEnd_pos As Integer
        Dim mPrevious_text As String
    
        mStart_pos = VBA.InStr(VBA.InStr(1, .XML, "Path"), .XML, """")
        mEnd_pos = VBA.InStr(mStart_pos + 1, .XML, """ ")
    
        mStart_pos = mStart_pos + 1
        mPrevious_text = VBA.mID(.XML, mStart_pos, mEnd_pos - mStart_pos)
        Debug.Print "previous path: " & mPrevious_text
        Debug.Print "will be replaced by: " & selectedFile
    
        .XML = VBA.Replace(.XML, mPrevious_text, mSelectedFile)
    
    End With
    
    'now run the modifieed saved import
    DoCmd.RunSavedImportExport "ImportSection-95"