Connessioni dati Microsoft Excel - Alter Connection String attraverso VBA

Question

Ho una domanda abbastanza semplice. Sto cercando di trovare un modo per modificare e modificare una stringa di connessione per una connessione dati esistente in una cartella di lavoro Excel tramite VBA (codice macro). Il motivo principale per cui sto cercando di farlo è trovare un modo per richiedere all'utente che apre la cartella di lavoro di inserire le proprie credenziali (Nome utente/Password) o avere una casella di controllo per Connessione sicura che verrebbe utilizzata nella stringa di connessione di quelle esistenti connessioni dati.

In questo momento le connessioni dati sono in esecuzione fuori di un utente di esempio che ho creato e che ha bisogno di andare via nella versione di produzione della cartella di lavoro. Spero che abbia senso?

È possibile? Se sì, potresti darmi un esempio/esempio di blocco di codice? Gradirei davvero qualche suggerimento a questo punto.

Answer 1

Questo è un duplicato di Excel macro to change external data query connections - e.g. point from one database to another

Sembra che la cosa principale sta usando le ThisWorkbook.Connections in VBA.

Answer 2

Avevo anche lo stesso esatto requisito e sebbene la doppia domanda Excel macro to change external data query connections - e.g. point from one database to another fosse utile, dovevo ancora modificarla per soddisfare i requisiti precisi sopra. Stavo lavorando con una connessione specifica, mentre quella risposta mirava a più connessioni. Quindi, ho incluso il mio lavoro qui. Grazie @Rory per il suo codice.

Anche grazie a Luke Maxwell per la sua funzione a search a string for matching keywords.

Assegna questo sottotitolo a un pulsante o chiamalo quando il foglio di calcolo è aperto.

Sub GetConnectionUserPassword() 
    Dim Username As String, Password As String 
    Dim ConnectionString As String 
    Dim MsgTitle As String 
    MsgTitle = "My Credentials" 

    If vbOK = MsgBox("You will be asked for your username and password.", vbOKCancel, MsgTitle) Then 
     Username = InputBox("Username", MsgTitle) 
      If Username = "" Then GoTo Cancelled 
      Password = InputBox("Password", MsgTitle) 
      If Password = "" Then GoTo Cancelled 
    Else 
    GoTo Cancelled 
    End If 

    ConnectionString = GetConnectionString(Username, Password) 
    ' MsgBox ConnectionString, vbOKOnly 
    UpdateQueryConnectionString ConnectionString 
    MsgBox "Credentials Updated", vbOKOnly, MsgTitle 
    Exit Sub 
Cancelled: 
    MsgBox "Credentials have not been changed.", vbOKOnly, MsgTitle 
End Sub 

La funzione GetConnectionString memorizza la stringa di connessione che si inserisce il nome utente e la password in. Questo è per una connessione OLEDB ed è ovviamente diverso a seconda dei requisiti del Provider.

Function GetConnectionString(Username As String, Password As String) 

    Dim result As Variant 

    result = "OLEDB;Provider=Your Provider;Data Source=SERVER;Initial Catalog=DATABASE" _ 
& ";User ID=" & Username & ";Password=" & Password & _ 
";Persist Security Info=True;Extended Properties=" _ 
& Chr(34) & "PORT=1706;LOG=ON;CASEINSENSITIVEFIND=ON;INCLUDECALCFIELDS=ON;" & Chr(34) 

    ' MsgBox result, vbOKOnly 
    GetConnectionString = result 
End Function 

Questo codice fa il lavoro di realtà l'aggiornamento di una connessione denominata con la nuova stringa di connessione (per la connessione OLE DB).

Sub UpdateQueryConnectionString(ConnectionString As String) 

    Dim cn As WorkbookConnection 
    Dim oledbCn As OLEDBConnection 
    Set cn = ThisWorkbook.Connections("Your Connection Name") 
    Set oledbCn = cn.OLEDBConnection 
    oledbCn.Connection = ConnectionString 

End Sub 

Al contrario, è possibile utilizzare questa funzione per ottenere qualunque sia la stringa di connessione corrente.

Function ConnectionString() 

    Dim Temp As String 
    Dim cn As WorkbookConnection 
    Dim oledbCn As OLEDBConnection 
    Set cn = ThisWorkbook.Connections("Your Connection Name") 
    Set oledbCn = cn.OLEDBConnection 
    Temp = oledbCn.Connection 
    ConnectionString = Temp 

End Function 

Io uso questo sub per aggiornare i dati quando si apre la cartella di lavoro, ma controlla che ci sia un nome utente e una password nella stringa di connessione prima di fare l'aggiornamento. Ho appena chiamato questo sub da Private Sub Workbook_Open().

Sub RefreshData() 

Dim CurrentCredentials As String 
Sheets("Sheetname").Unprotect Password:="mypassword" 
CurrentCredentials = ConnectionString() 
If ListSearch(CurrentCredentials, "None", "") > 0 Then 
GetConnectionUserPassword 
End If 
Application.ScreenUpdating = False 
ActiveWorkbook.Connections("My Connection Name").Refresh 
Sheets("Sheetname").Protect _ 
Password:="mypassword", _ 
UserInterfaceOnly:=True, _ 
AllowFiltering:=True, _ 
AllowSorting:=True, _ 
AllowUsingPivotTables:=True 
End Sub 

Ecco la funzione ListSearch di Luke. Restituisce il numero di corrispondenze che ha trovato.

Function ListSearch(text As String, wordlist As String, seperator As String, Optional caseSensitive As Boolean = False) 
    Dim intMatches As Integer 
    Dim res As Variant 
    Dim arrWords() As String 
    intMatches = 0 
    arrWords = Split(wordlist, seperator) 
    On Error Resume Next 
    Err.Clear 
    For Each word In arrWords 
     If caseSensitive = False Then 
      res = InStr(LCase(text), LCase(word)) 
     Else 
      res = InStr(text, word) 
     End If 
     If res > 0 Then 
      intMatches = intMatches + 1 
     End If 
    Next word 
    ListSearch = intMatches 
End Function 

Infine, se si vuole essere in grado di rimuovere le credenziali, basta assegnare questo sub a un pulsante.

Sub RemoveCredentials() 
    Dim ConnectionString As String 
    ConnectionString = GetConnectionString("None", "None") 
    UpdateQueryConnectionString ConnectionString 
    MsgBox "Credentials have been removed.", vbOKOnly, "Your Credentials" 
End Sub 

Spero che questo aiuti un'altra persona come me, che stava cercando di risolvere questo problema in fretta.