Question

如何让MS Access通过VBA宏重新链接外部Excel工作簿？

我可以使用链接表管理器执行此操作，但我想通过VBA执行此操作，以便我可以创建一个按钮供用户按下以找到新工作簿

选择新工作簿
重新链接外部Excel工作簿

. capt prog drop appendmodels

. *! version 1.0.0  14aug2007  Ben Jann
. program appendmodels, eclass
  1.     // using first equation of model
.     version 8
  2.     syntax namelist
  3.     tempname b V tmp
  4.     foreach name of local namelist {
  5.         qui est restore `name'
  6.         mat `tmp' = e(b)
  7.         local eq1: coleq `tmp'
  8.         gettoken eq1 : eq1
  9.         mat `tmp' = `tmp'[1,"`eq1':"]
 10.         local cons = colnumb(`tmp',"_cons")
 11.         if `cons'<. & `cons'>1 {
 12.             mat `tmp' = `tmp'[1,1..`cons'-1]
 13.         }
 14.         mat `b' = nullmat(`b') , `tmp'
 15.         mat `tmp' = e(V)
 16.         mat `tmp' = `tmp'["`eq1':","`eq1':"]
 17.         if `cons'<. & `cons'>1 {
 18.             mat `tmp' = `tmp'[1..`cons'-1,1..`cons'-1]
 19.         }
 20.         capt confirm matrix `V'
 21.         if _rc {
 22.             mat `V' = `tmp'
 23.         }
 24.         else {
 25.             mat `V' = ///
>             ( `V' , J(rowsof(`V'),colsof(`tmp'),0) ) \ ///
>             ( J(rowsof(`tmp'),colsof(`V'),0) , `tmp' )
 26.         }
 27.     }
 28.     local names: colfullnames `b'
 29.     mat coln `V' = `names'
 30.     mat rown `V' = `names'
 31.     eret post `b' `V'
 32.     eret local cmd "whatever"
 33. end

. sysuse auto
(1978 Automobile Data)

. eststo b1: quietly regress price weight

. eststo b2: quietly regress price mpg

. eststo b3: quietly regress price foreign

. eststo bivar: appendmodels b1 b2 b3

. esttab b1 b2 b3 bivar, mtitles

Answer 1

我使用以下代码重新连接到链接表。

Public Function FixTableLink()

Dim db As Database
Dim strPath As String
Dim strConnect As String

strPath = CurrentProject.Path
strPath = strPath & "\DatabaseName.extention"

strConnect = ";DATABASE=" & strPath

Set db = CurrentDb

For Each tbl In db.TableDefs

    If Nz(DLookup("Type", "MSysObjects", "Name = '" & tbl.name & "'"), 0) = 6 And tbl.Connect <> strConnect Then

        tbl.Connect = strConnect
        tbl.RefreshLink

    End If

Next tbl

End Function

将strPath更改为后端的路径

您可以使用以下代码打开一个对话框来搜索文件路径

Function SelectFile() As String

        On Error GoTo ExitSelectFile

        Dim objFileDialog    As Object
        Set objFileDialog = Application.FileDialog(1)

        With objFileDialog

            .AllowMultiSelect = False
            .Show

            Dim varSelectedItem As Variant

            For Each varSelectedItem In .SelectedItems

                SelectFile = varSelectedItem

            Next varSelectedItem

       End With

    ExitSelectFile:

    Set objFileDialog = Nothing

End Function

'File type filters can be added to the filedialog property using the following syntax:

   '.Filters.Clear
   '.Filters.Add "File Type Description", "*.file extension"

''Start folder can be specified using:
'.initialfilename="folder path"

然后在第一个代码块中，您可以使用

strPath = selectfile

Answer 2

也许这样的事情。

Dim InputFile As String
Dim InputPath As String

InputPath = "C:\ExcelPath\"
InputFile = Dir(InputPath & "*.xls")

Do While InputFile <> ""

    DoCmd.TransferSpreadsheet acLink, , "Your table name","Path to your workbook file", True, "Sheet1!RangeYouNeed"
    InputFile = Dir
Loop

访问VBA - 重新链接外部Excel工作簿

2 个答案: