[發問] 請問ACCESS 連接 SQL server VBA程式

wsx1130

請問有辦法直接使用vba直接連接SQL後並轉成Access資料庫

rocaf

回復 1# wsx1130 沒記錯的話，要看原始料庫是什麼，我以前是用ODBC連ORACLE資料庫，針對需要的部分轉成Access

neilgboy

以前在網上看到的~~
Function AttachDSNLessTableSQLServer(stLocalTableName As String, _
                                     stRemoteTableName As String, _
                                     stServer As String, _
                                     stDatabase As String, _
                                     Optional stUsername As String, _
                                     Optional stPassword As String, _
                                     Optional strKey As String, _
                                     Optional strDescription As String = "")
'    stLocalTableName  本地資料表名稱
'    stRemoteTableName 伺服器資料表名稱
'    stServer          伺服器名稱或IP
'    stDatabase        資料庫名稱
'    stUsername        使用者名稱
'    stPassword        使用者密碼
'    strKey            索引套用欄位
'    strDescription    資料表描述
   
    On Error GoTo AttachDSNLessTableSQLServer_Err
    Dim td As TableDef
    Dim stConnect As String
   
    CurrentDb.TableDefs.Delete stLocalTableName
      
    If Len(stUsername) = 0 Then
        '//Use trusted authentication if stUsername is not supplied.
        stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes"
    Else
        '//WARNING: This will save the username and the password with the linked table information.
        stConnect = "ODBC;DRIVER=SQL Server;SERVER={" & stServer & "};DATABASE=" & stDatabase & ";UID=" & stUsername & ";PWD=" & stPassword
    End If
    Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, stConnect)
    CurrentDb.TableDefs.Append td
   
    '建立索引
    If Len(strKey) > 0 Then
        DoCmd.RunSQL "CREATE UNIQUE INDEX UniqueIndex ON [" & stLocalTableName & "] (" & strKey & ")"
    End If

    '建立描述
    If strDescription <> "" Then
        Set prp = CurrentDb.TableDefs(stLocalTableName).CreateProperty("Description", dbText, strDescription)
        CurrentDb.TableDefs(stLocalTableName).Properties.Append prp
   
    End If

    AttachDSNLessTableSQLServer = True
    Exit Function

AttachDSNLessTableSQLServer_Err:
   
    If err.Number = 3265 Then
        '刪除連結資料表時，資料表不存在
        Resume Next
    Else
        AttachDSNLessTableSQLServer = False
        MsgBox "AttachDSNLessTableSQLServer encountered an unexpected error: " & err.Description
    End If
   
End Function