How to delete or hide the password typing of data access from a server running SQL Server from VBA or Excel macro?

Question

How to delete or hide the password typing of data access from a server running SQL Server from VBA or Excel macro?

Navigation

#1 by (2 votes)

2

I am performing a migration service from a database with a SQL Server server in a company, but have asked me to intermediate the migration in Excel Spreadsheets, because they want so in this first phase to advance some treatments in same worksheet.

I have no experience with SQL Server , but with Excel advanced and VBA , and with the help of a technician who manipulates SQL Server in a basic way I created a macro and then adapted it as shown below; and it worked in this first test I did.

   For i = 1 To 3

   Select Case i

      Case 1
         Sheets("Plan1").Select
         N = "BD1"

      Case 2
         Sheets("Plan3").Select
         N = "BD2"

      Case 3
         Sheets("Plan5").Select
         N = "BD3"

   End Select

   With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Data Source=10.0.0.5\sqlexpress;Use Procedure for Prepare=1;Auto Trans", _
        "late=True;Packet Size=4096;Workstation ID=LABORATORIO;Use Encryption for Data=False;Tag with column collation when possible=Fals", "e;Initial Catalog=Dados"), Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("""Dados"".""dbo""." & N & "")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceConnectionFile = _
        "C:.0.0.5_sqlexpress Dados " & N & ".odc"
        .ListObject.DisplayName = _
        "Tabela__10.0.0.5_sqlexpress_Dados_" & N
        .Refresh BackgroundQuery:=False
    End With

    Cells.Select

    Selection.Copy

    Select Case i

       Case 1
          Sheets("Plan2").Select

       Case 2
          Sheets("Plan4").Select

       Case 3
          Sheets("Plan6").Select
    End Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

   Range("A1").Select

Next i

Under Plan1 the first data is opened perfectly, and a copy of it is made to Plan2 by pasting everything as "values"; for the other two it's the same, but it's Plan3 with Plan 4 and then Plan5 with Plan6 .

This is an initial test, so it stayed this way, I will improve as soon as I work what I need.

Peer tabs get the data the customer wants. My problem is that this data is from a system that will be disabled is are more than 400 tables (not typed wrong) to migrate.

As it is, in each "loop" the database access password is requested.

I have not found how to put this password via macro or VBA in order for everything to be done automatically, without interruption (typing the password in a popup

Can anyone help me? Thank you in advance.

sql-server excel vba

asked by anonymous 29.06.2017 / 05:06

1 answer

Leave the autocomplete search in bold How to align a checkbox next to a label?

score 2 · Answer 1

Friend, see if the function below caters to you:

Sub SQLConnect(servername As String, dbname As String, tablename As String, uname As String, pword As String, sheetname as String)

'******************************************************
' Login no Servidor
'******************************************************
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection

' Teste 1 - Usando conexão direta:    
On Error GoTo ErrHand
    With cn
        .ConnectionString = "Driver={SQL Server};Server=" & servername & _
            ";Database=" & dbname & ";" & _
            "Uid=" & uname & ";" & _
            "Pwd=" & pword
            .Open
    End With

' Teste 2 - Usando conexão OLEDB:
' On Error GoTo ErrHand
'   With cn
'        .ConnectionString = "Provider=SQLOLEDB;Data Source=" & servername & ";" & _
'            "Initial Catalog=" & dbname & ";" & _
'            "User ID=" & uname & ";" & _
'            "Password=" & pword & ";"
'            .Open
'    End With

    Call MsgBox("Conexão com o banco de dados OK!", vbOKOnly + vbInformation, "Sucesso")

'******************************************************
' Faz a consulta SQL
'******************************************************
Dim rs As ADODB.Recordset
Dim sqlString As String
Set rs = New ADODB.Recordset

sqlString = "SELECT * from " & tablename
rs.Open sqlString, cn, adOpenStatic, adLockOptimistic
cn.Execute (sqlString)

'******************************************************
' Coloca dados na planilha
'******************************************************
Dim fld as ADODB.Field
Dim iSheet as Integer

iSheet = Sheets(sheetname).Index

' Cria o cabeçalho
i = 0 
With Worksheets(iSheet).Range("A1") 
  For Each fld In rs.Fields 
   .Offset(0, i).Value = fld.Name 
   i = i + 1 
 Next fld 
End With 

' Transfere os dados
Worksheets(iSheet).Range("A2").CopyFromRecordset rs

ExitHere:
 On Error Resume Next
 cn.Close
 Set cn = Nothing
 Err.Clear
 Exit Sub

ErrHand:
 MsgBox "Conexão não definida.", vbExclamation
 Resume ExitHere

End Sub

I've adapted this feature from this font , unfortunately I could not test .