Public Sub RunSpecOnOtherFile(ByVal SpecName As String, ByVal objName As String, _
ByVal ObjType As String, _
ByVal Path As String)
'
' arnelgp
'
' runs import/export specs to another file
'
' SpecName = name of import/export spec
' objName = name of query or table to import/export
' ObjType = either "Query" or "Table" to import/export
' Path = Path + filename(including extension) to create
'
Dim objSpec As ImportExportSpecification
Dim strXML As String
Dim intStartPos As Integer, intEndPos As Integer
Set objSpec = CurrentProject.ImportExportSpecifications.Item(SpecName)
' get the xml string
strXML = objSpec.xml
'Debug.Print
'Debug.Print strXML
'replace the Path part
intStartPos = InStr(1, strXML, "Path")
intStartPos = InStr(intStartPos, strXML, "=")
intEndPos = InStr(intStartPos, strXML, "xmlns") - 1
' insert the new filename between intstartpos and intendpos
strXML = Left(strXML, intStartPos) & " " & _
"""" & Path & """" & _
Mid(strXML, intEndPos)
'Debug.Print
'Debug.Print strXML
' replace the objName
strXML = RegExpReplace(strXML, "AccessObject=" & Chr(34) & "[\w]{1,}" & Chr(34), "AccessObject=" & Chr(34) & objName & Chr(34))
'Debug.Print
'Debug.Print strXML
' replace the ObjType
strXML = RegExpReplace(strXML, "ObjectType=" & Chr(34) & "[\w]{1,}" & Chr(34), "ObjectType=" & Chr(34) & ObjType & Chr(34))
'Debug.Print
'Debug.Print strXML
' replace the xml of the spec to the new strXML
objSpec.xml = strXML
' run the specification
objSpec.Execute
' close it
Set objSpec = Nothing
End Sub
''''''''''''
' helper
''''''''''''
Public Function RegExpReplace(ByVal WhichString As String, _
ByVal Pattern As String, _
ByVal ReplaceWith As String, _
Optional ByVal IsGlobal As Boolean = True, _
Optional ByVal IsCaseSensitive As Boolean = True) As String
With CreateObject("vbscript.regexp")
.Global = IsGlobal
.Pattern = Pattern
.IgnoreCase = Not IsCaseSensitive
RegExpReplace = .Replace(WhichString, ReplaceWith)
End With
End Function