Не искам да използвам DSN, тъй като използвам ODBC драйвер за разлика от OLE DB. Като се позовава на DSN, горният код работи с много малко промени.
Вижте този въпрос за това как намерих отговора, след като започнах да подозирам OLE DB/ODBC за проблема.ADO работи ли с ODBC драйвери или само с OLE DB доставчици?
Нов код тук:
Sub GetCustomers()
Dim oConn As New ADODB.connection
Dim cmd As New ADODB.Command
' Connection Parameters
Dim strUsername As String
Dim strPassword As String
Dim strServerAddress As String
Dim strDatabase As String
' User:
strUsername = Sheets("CONFIG").Range("B4").Value
' Password:
strPassword = Sheets("CONFIG").Range("B5").Value
' Server Address:
strServerAddress = Sheets("CONFIG").Range("B6").Value
' Database
strDatabase = Sheets("CONFIG").Range("B3").Value
oConn.Open "DSN=my_system_dsn;" & _
"Database=" & strDatabase & ";" & _
"Uid=" & strUsername & ";" & _
"Pwd=" & strPassword
Set xlSheet = Sheets("CUSTOMERS")
xlSheet.Activate
Range("A3").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Range("A1").Select
Dim strSQL As String
strSQL = "SELECT * FROM customers"
cmd.CommandType = ADODB.CommandTypeEnum.adCmdText
cmd.ActiveConnection = oConn
cmd.CommandText = strSQL
Set rs = New ADODB.Recordset
Set rs = cmd.Execute
For i = 1 To rs.Fields.Count
ActiveSheet.Cells(3, i).Value = rs.Fields(i - 1).Name
Next i
xlSheet.Range(xlSheet.Cells(3, 1), _
xlSheet.Cells(3, rs.Fields.Count)).Font.Bold = True
ActiveSheet.Range("A4").CopyFromRecordset rs
xlSheet.Select
Range("A3").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Range("A1").Select
rs.Close
oConn.Close
Set cmd = Nothing
Set param = Nothing
Set rs = Nothing
Set cnn = Nothing
Set xlSheet = Nothing
End Sub
Системният DSN е конфигуриран да използва драйвера PostgreSQL Unicode. Избрах да не използвам OLE DB, въпреки че има наличен доставчик. Ако погледнете PGFoundry, ще видите, че има много проблеми и не е актуализиран от няколко години.