excel VBAを使用してSQLテーブルに書き込む方法

Question

私はAuditというSQLテーブルを持っています。この表には、UNとCNという2つのフィールドがあります。私のサーバー名はanaliveで、DBはDW_ALLです。私はエクセルでユーザー名とコンピュータ名をキャプチャしようとしています。私のワークブックやシートをアクセスしたりオープンしたりして、その監査情報をSQLテーブルに書き出します。

Sub UpdateTable() 

Dim cnn As ADODB.Connection 
Dim uSQL As String 
Dim strText As String 
Dim strDate As Date 

strText = ActiveSheet.Range("b4").Value 
''strDate = Format(ActiveSheet.Range("c4").Value, "dd/mm/yyyy")'' 

Set cnn = New Connection 
cnnstr = "Provider=SQLOLEDB; " & _ 
     "Data Source=icl-analive; " & _ 
     "Initial Catalog=DW_ALL;" & _ 
     "User ID=ccataldo;" & _ 
     "Trusted_Connection=Yes;" 

cnn.Open cnnstr 

''uSQL = "INSERT INTO tbl_ExcelUpdate (CellText,CellDate) VALUES ('" & strText & "', " & strDate & ")"'' 
''uSQL = "INSERT INTO Audit (UN,CN) VALUES (MsgBox Environ("username"), MsgBox   Environ("username""'' 
uSQL = INSERT INTO Audit (UN,CN) VALUES ('MsgBox Environ("username") ', 'MsgBox Environ("username"')) 

Debug.Print uSQL 

cnn.Execute uSQL 
cnn.Close 
Set cnn = Nothing 
Exit Sub 
End Sub 

Answer 1

接続文字列はトリッキーなものになる可能性があります。私はConnectionStrings.comに大きく依存して私の記憶をリフレッシュしています。

Trusted_ConnectionとUser IDは互いに排他的です。 Windowsアカウントを使用してSQL Serverにログオンする場合は、信頼された接続を使用します。ユーザー名とパスワードはSQL accountでログインするためのものです。

Windowsログインを使用すると仮定します。ここで

Provider=SQLNCLI11;Server=analive;Database=DW_ALL;Trusted_Connection=yes;

Answer 2

がAccessDBに書き込みを行うサンプルスクリプトです：これを試してみてください。 SQLは、必要なvbaステートメントと同様にする必要があります。私はそれが助けてくれることを願っています

また、DAOを使用しており、Addob接続タイプではありません。

Private Sub thisbetheshitmane() 
    Dim db As DAO.Database 
    Dim rst As DAO.Recordset 
    Dim tb As DAO.TableDef 
    Dim vAr As String 
    Dim i As Integer 
    Dim y As Integer 
    Dim InCombined As Boolean 
    Dim InOpen As Boolean 
    Dim vbSql As String 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.Calculation = xlCalculationManual 

    Dim StartTime As Double 
    Dim SecondsElapsed As Double 

    StartTime = Timer 

    Set db = DBEngine.OpenDatabase("C:\Users\dzcoats\Documents\Microsoft.accdb") 

    For Each tb In db.TableDefs 
     If Len(tb.Connect) > 0 Then 
      tb.RefreshLink 
     End If 
    Next tb  

    Set rst = db.OpenRecordset("SELECT DISTINCT [Table_Name].Defect FROM [Table_Name] WHERE [Table_Name].Defect IS NOT NULL;") 

    Dim QResult() As Variant 
    QResult = rst.GetRows(rst.RecordCount) 
    For a = LBound(QResult, 2) To UBound(QResult, 2) 
     vAr = QResult(0, a) 
    Next a 

    For y = LBound(QResult, 2) To UBound(QResult, 2) 
     If vAr <> "Defect" And vAr <> vbNullString And vAr <> "" Then 

      If InCombined = True And InOpen = True Then 
       vbSql = "UPDATE [Table_Name] SET [Table_Name].Status ='Bad Defect Number' WHERE ((([Table_Name].Defect)='" & vAr & "'));" 
       db.Execute vbSql 
      End If 

      If InCombined = False And InOpen = True Then 
       vbSql = "UPDATE [Table_Name] SET [Table_Name].Status ='Completed' WHERE ((([Table_Name].Defect)='" & vAr & "'));" 
       db.Execute vbSql 
      End If 

     End If 
    Next y 

    rst.Close 
    Set rs = Nothing 
    db.Close 
    Set db = Nothing 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.Calculation = xlCalculationAutomatic 

SecondsElapsed = Round(Timer - StartTime, 2) 
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation 

End Sub