Centrally documenting excel connection strings from multiple workbooks

[chris_who]

Hi all,

VBA noob here - I've been given the task of documenting all of the excel connection strings used by a large variety of workbooks in a folder structure...

what I need is a tool that sniffs out connection strings and documents the file name, location and connection string info sequentially into a workbook or a SQL table.

So far - I have code that iteratively opens up workbooks in folder a structure (found elsewhere) but have no idea how to find and then write the information to a central repository...

The code I have is as below:

Sub Test_Trawler()
On Error GoTo err_TT
'
' Test_Trawler Macro
'
Dim strFolder As String
Dim strFile As String
Dim strTemp As String
Dim strTest As String
Dim intTemp As String

'Set up our intial values
strFolder = Range("C3").Value
If Right(strFolder, 1) <> "\" Then
    strFolder = strFolder & "\"
End If

'Check to see if there are any Excel files, and quit if not
strFile = Dir(strFolder & "*.xls*")
If strFile = "" Then
    MsgBox "No Excel Files Found"
    Exit Sub
End If

'Pick up the name of our temp folder
strTemp = Range("C4").Value
intTemp = 1

'Check to see if the temp folder exists
'If it does, add subscripts until we find one that works
If Dir(strFolder & strTemp, vbDirectory) <> "" Then
    strTest = strTemp
    Do Until strTest = ""
        strTest = strTemp & CStr(intTemp)
        If Dir(strFolder & strTest) = "" Then
            strTemp = strTest
            strTest = ""
        Else
            intTemp = intTemp + 1
        End If
    Loop
End If

'Create our temp folder
MkDir (strFolder & strTemp)

'Open each workbook in the folder in turn, process it, then move it to the temp folder
Do Until strFile = ""
    Workbooks.Open strFolder & strFile
    'Insert code to run while workbook is open
    Workbooks(strFile).Close (False)
    
    Call Safe_Move(strFolder & strFile, strFolder & strTemp & "\" & strFile)
    
    strFile = Dir(strFolder & "*.xls*")
Loop

'Finished processing files, now move them from the temp folder back to the original

strFile = Dir(strFolder & strTemp & "\*.xls*")
Do Until strFile = ""
    Call Safe_Move(strFolder & strTemp & "\" & strFile, strFolder & strFile)
    strFile = Dir(strFolder & strTemp & "\*.xls*")
Loop

'Delete the temp folder
RmDir (strFolder & strTemp)

'Let the user know we've finished
MsgBox "The following folder has been processed: " & vbCrLf & strFolder, vbInformation, "Finished"



Exit Sub

err_TT:

    Stop
    Resume
'
End Sub


Function Safe_Move(strFrom As String, strTo As String) As Boolean
On Error GoTo err_SM

'Copy the file to the new location
FileCopy strFrom, strTo

'Check the copy has been created
If Dir(strTo) = "" Then
    'Copy not found, alert the user
    MsgBox "Failed to move file " & strFrom & " to " & strTo & vbCrLf & "Please investigate", vbCritical, "File move failed"
    Safe_Move = False
    Exit Function
Else
    'Delete the original if the copy is found
    Kill strFrom
End If
    
Safe_Move = True

Exit Function

err_SM:
    Safe_Move = False
    Stop
    Resume
    


End Function

Any other help would be greatly appreciated! Thank you!

 

[SkipVought]

Hi,

Give this a try...

'Open each workbook in the folder in turn, process it, then move it to the temp folder
    Dim ws As Worksheet, sConnODBC As String, sConnOLEDB As String, i As Integer
    Do Until strFile = ""
    
        With Workbooks.Open(strFolder & strFile)
'            Insert code to run while workbook is open
            For i = 1 To .Connections.Count
                If .Connections(i).Type = xlConnectionTypeODBC Then
                    sConnODBC = .Connections(i).ODBCConnection.CommandText
                Else
                    sConnOLEDB = .Connections(i).OLEDBConnection.CommandText
                End If
                
            Next
            .Close (False)
        End With
        
        Call Safe_Move(strFolder & strFile, strFolder & strTemp & "\" & strFile)

        strFile = Dir(strFolder & "*.xls*")
    Loop

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[chris_who]

Hi Skip,

thanks so much for a really quick response - it got me 90% of the way!

For those that have an interest - the final code set is here:

Sub Test_Trawler()
On Error GoTo err_TT
'
' Test_Trawler Macro
'
Dim strFolder As String
Dim strFile As String
Dim strTemp As String
Dim strTest As String
Dim intTemp As String
Dim strThisWindow As String
Dim strLogSheet As String

Dim ws As Worksheet
Dim sConnODBC As String
Dim sConnOLEDB As String
Dim i As Integer

Dim intMaxConn As Integer
Dim asConn(1 To 1000) As String

'Let's turn off the epilepsy-inducing screen refresh, shall we?
Application.ScreenUpdating = False

'Set up our intial values
strThisWindow = ActiveWorkbook.Name
strLogSheet = "datasheet"

Sheets("FilePath").Select
strFolder = Range("C3").Value
If Right(strFolder, 1) <> "\" Then
    strFolder = strFolder & "\"
End If

'Check to see if there are any Excel files, and quit if not
strFile = Dir(strFolder & "*.xls*")
If strFile = "" Then
    MsgBox "No Excel Files Found"
    Exit Sub
End If

'Pick up the name of our temp folder
strTemp = Range("C4").Value
intTemp = 1

'Check to see if the temp folder exists
'If it does, add subscripts until we find one that works
If Dir(strFolder & strTemp, vbDirectory) <> "" Then
    strTest = strTemp
    Do Until strTest = ""
        strTest = strTemp & CStr(intTemp)
        If Dir(strFolder & strTest, vbDirectory) = "" Then
            strTemp = strTest
            strTest = ""
        Else
            intTemp = intTemp + 1
        End If
    Loop
End If

'Create our temp folder
MkDir (strFolder & strTemp)

'Open each workbook in the folder in turn, process it, then move it to the temp folder
'Do Until strFile = ""
    'Workbooks.Open strFolder & strFile
    
    
    '***************************************************************************************************
    
'Open each workbook in the folder in turn, process it, then move it to the temp folder
    Do Until strFile = ""
    
        With Workbooks.Open(strFolder & strFile)


            'Write connection strings to an array
            intMaxConn = .Connections.Count
            For i = 1 To intMaxConn
                If .Connections(i).Type = xlConnectionTypeODBC Then
                    asConn(i) = .Connections(i).ODBCConnection.Connection
                Else
                    asConn(i) = .Connections(i).OLEDBConnection.Connection
                End If
            Next i
        End With
             
            'Return to Log sheet
            Windows(strThisWindow).Activate
            Sheets(strLogSheet).Select
            
            'Move cursor to end of list
            If Range("A4").Value = "" Then
                Range("A4").Select
            Else
                Range("A3").Select
                Selection.End(xlDown).Select
                ActiveCell.Offset(1, 0).Select
            End If
             
            'Write non-blank connection strings to log
            For i = 1 To intMaxConn
                If asConn(i) <> "" Then
                    ActiveCell.Value = strFolder & strFile
                    ActiveCell.Offset(0, 1).Value = asConn(i)
                    ActiveCell.Offset(1, 0).Select
                End If
            Next i
             
            'Blank array ready for next round
            For i = 1 To intMaxConn
                asConn(i) = ""
            Next i
            
        Workbooks(strFile).Close (False)
        
        Call Safe_Move(strFolder & strFile, strFolder & strTemp & "\" & strFile)

        strFile = Dir(strFolder & "*.xls*")
    Loop
    '***************************************************************************************************

    
    'Insert code to run while workbook is open
 '   Workbooks(strFile).Close (False)
    
    'Call Safe_Move(strFolder & strFile, strFolder & strTemp & "\" & strFile)
    
    'strFile = Dir(strFolder & "*.xls*")
'Loop

'Finished processing files, now move them from the temp folder back to the original
'There is a better way to do this, but I can't remember it offhand
strFile = Dir(strFolder & strTemp & "\*.xls*")
Do Until strFile = ""
    Call Safe_Move(strFolder & strTemp & "\" & strFile, strFolder & strFile)
    strFile = Dir(strFolder & strTemp & "\*.xls*")
Loop



'Delete the temp folder
RmDir (strFolder & strTemp)

'Turn the screen refresh back on
Application.ScreenUpdating = True

'Let the user know we've finished
MsgBox "The following folder has been processed: " & vbCrLf & strFolder, vbInformation, "Finished"


Exit Sub

err_TT:
    'Turn the screen refresh back on
    Application.ScreenUpdating = True

    Stop
    Resume
'
End Sub


Function Safe_Move(strFrom As String, strTo As String) As Boolean
On Error GoTo err_SM

'Copy the file to the new location
FileCopy strFrom, strTo

'Check the copy has been created
If Dir(strTo) = "" Then
    'Copy not found, alert the user
    MsgBox "Failed to move file " & strFrom & " to " & strTo & vbCrLf & "Please investigate", vbCritical, "File move failed"
    Safe_Move = False
    Exit Function
Else
    'Delete the original if the copy is found
    Kill strFrom
End If
    
Safe_Move = True

Exit Function

err_SM:
    Safe_Move = False
    Stop
    Resume
    


End Function