Home » Infrastructure » Windows » Free to use, Helpful VBA Code to extract ODBC Connect Details form Excel Query an Excel Pivot Query  () 1 Vote
icon14.gif  Free to use, Helpful VBA Code to extract ODBC Connect Details form Excel Query an Excel Pivot Query [message #214427] Tue, 16 January 2007 07:30
rustico64
Messages: 3
Registered: January 2007
Location: Switzerland
Junior Member
Hi all in there

here a VBA code to extract connection string and sql statements of excel files after a switch into a new DB or set new Login and or password. Microsoft Query does not allow to change the SQL or Connection String.

Free to use, it creates a new Table to extract the details. After the extract, you can change the details and import back to the Excel sheet.

This codes help me out of many sleepless nights! Cool

Regards

Martin

'1. for standard Query to extract

Sub QuerysAuslesen()
Dim qrt As QueryTable
Dim wsh As Worksheet
Dim bAddList As Boolean
Dim iQueryCnt As Integer

iQueryCnt = 0
bAddList = True
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Name = "QueryList" Then
bAddList = False
Exit For
End If
Next
If bAddList Then
ActiveWorkbook.Sheets.Add Before:=ActiveWorkbook.Worksheets(1)
ActiveSheet.Name = "QueryList"
End If
Sheets("QueryList").Cells(1, 1).Value = "BlattName"
Sheets("QueryList").Cells(1, 2).Value = "QueryName"
Sheets("QueryList").Cells(1, 3).Value = "ConnectionString"
Sheets("QueryList").Cells(1, 4).Value = "SQLString"
For Each wsh In ActiveWorkbook.Worksheets
For Each qrt In wsh.QueryTables
iQueryCnt = iQueryCnt + 1
Sheets("QueryList").Cells(1 + iQueryCnt, 1) = wsh.Name
Sheets("QueryList").Cells(1 + iQueryCnt, 2) = qrt.Name
Sheets("QueryList").Cells(1 + iQueryCnt, 3) = qrt.Connection
Sheets("QueryList").Cells(1 + iQueryCnt, 4) = qrt.Sql
Next
Next
If iQueryCnt = 0 Then
MsgBox "Keine Queries in dieser Arbeitsmappe", vbExclamation
Else
MsgBox "Total " & iQueryCnt & " Queries in der Arbeitsmappe.", vbInformation
End If
End Sub

'2. for standard Query to import

Sub QueriesEinlesen()
Dim qrt As QueryTable
Dim wsh As Worksheet
Dim bExistList As Boolean
Dim iQueryCnt As Integer

bExistList = False
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Name = "QueryList" Then
bExistList = True
Exit For
End If
Next
If Not (bExistList) Then
MsgBox "QueryList existiert nicht !" & vbCrLf & _
"Keine Queries angepasst", vbCritical
Exit Sub
End If

For Each wsh In ActiveWorkbook.Worksheets
For Each qrt In wsh.QueryTables
iQueryCnt = 1
Do While Sheets("QueryList").Cells(1 + iQueryCnt, 1).Value <> ""
If wsh.Name = Sheets("QueryList").Cells(1 + iQueryCnt, 1).Value And _
qrt.Name = Sheets("QueryList").Cells(1 + iQueryCnt, 2) Then
qrt.Connection = Sheets("QueryList").Cells(1 + iQueryCnt, 3).Value
qrt.Sql = Sheets("QueryList").Cells(1 + iQueryCnt, 4).Value
MsgBox "Blatt:" & wsh.Name & vbCrLf & _
"Query:" & qrt.Name & " angepasst!", vbInformation
End If
iQueryCnt = iQueryCnt + 1
Loop
Next
Next
End Sub

'3. for Pivot querys extract

Sub PivotSourceDataAuslesen()
Dim pvt As PivotTable
Dim wsh As Worksheet
Dim Tab_vorhanden As Boolean
Dim SourceArray As Variant
Dim ixArray As Integer
Dim pvt_Anzahl As Integer

pvt_Anzahl = 0
Tab_vorhanden = True
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Name = "PivotSource" Then
Tab_vorhanden = False
Exit For
End If
Next
If Tab_vorhanden Then
ActiveWorkbook.Sheets.Add Before:=ActiveWorkbook.Worksheets(1)
ActiveSheet.Name = "PivotSource"
End If
Sheets("PivotSource").Cells(1, 1).Value = "Tabelle"
Sheets("PivotSource").Cells(1, 2).Value = "Pivot"
Sheets("PivotSource").Cells(1, 3).Value = "ArrayElements"
Sheets("PivotSource").Cells(1, 4).Value = "SourceData"

For Each wsh In ActiveWorkbook.Worksheets
For Each pvt In wsh.PivotTables
pvt_Anzahl = pvt_Anzahl + 1
Sheets("PivotSource").Cells(1 + pvt_Anzahl, 1) = wsh.Name
Sheets("PivotSource").Cells(1 + pvt_Anzahl, 2) = pvt.Name
SourceArray = pvt.SourceData
Sheets("PivotSource").Cells(1 + pvt_Anzahl, 3) = UBound(pvt.SourceData)
For ixArray = 1 To UBound(pvt.SourceData)
Sheets("PivotSource").Cells(1 + pvt_Anzahl, 3 + ixArray) = SourceArray(ixArray)
Next ixArray
Next
Next
If pvt_Anzahl = 0 Then
MsgBox "Keine Pivottabellen in dieser Arbeitsmappe", vbExclamation
Else
MsgBox "Total " & pvt_Anzahl & " Pivottabellen in der Arbeitsmappe.", vbInformation
End If
End Sub


'4. for Pivot querys extract

Sub PivotSourceDataEinlesen()
Dim pvt As PivotTable
Dim wsh As Worksheet
Dim SourceArray As Variant
Dim ixArray As Integer
Dim Tab_vorhanden As Boolean
Dim pvt_Anzahl As Integer

Tab_vorhanden = False
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Name = "PivotSource" Then
Tab_vorhanden = True
Exit For
End If
Next
If Not (Tab_vorhanden) Then
MsgBox "Keine PivotSourcedata vorhanden!" & vbCrLf & _
"Update nicht erfolgt!", vbCritical
Exit Sub
End If

For Each wsh In ActiveWorkbook.Worksheets
For Each pvt In wsh.PivotTables
pvt_Anzahl = 1
Do While Sheets("PivotSource").Cells(1 + pvt_Anzahl, 1).Value <> ""
If wsh.Name = Sheets("PivotSource").Cells(1 + pvt_Anzahl, 1).Value And _
pvt.Name = Sheets("PivotSource").Cells(1 + pvt_Anzahl, 2) Then
ReDim SourceArray(1 To Sheets("PivotSource").Cells(1 + pvt_Anzahl, 3).Value)
For ixArray = 1 To Sheets("PivotSource").Cells(1 + pvt_Anzahl, 3).Value
SourceArray(ixArray) = Sheets("PivotSource").Cells(1 + pvt_Anzahl, 3 + ixArray).Value
Next ixArray
pvt.SourceData = SourceArray
MsgBox "Blatt:" & wsh.Name & vbCrLf & _
"Pivot:" & pvt.Name & " angepasst!", vbInformation
End If
pvt_Anzahl = pvt_Anzahl + 1
Loop
Next
Next
End Sub

[Updated on: Tue, 16 January 2007 07:32]

Report message to a moderator

Previous Topic: Oracle 10g Client - OracleMTSRecoveryService
Next Topic: 3 Errors ORA during the installation
Goto Forum:
  


Current Time: Fri Dec 09 07:36:08 CST 2016

Total time taken to generate the page: 0.06155 seconds