INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Centrally documenting excel connection strings from multiple workbooks

Centrally documenting excel connection strings from multiple workbooks

(OP)
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:

CODE --> vba

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!

RE: Centrally documenting excel connection strings from multiple workbooks

Hi,

Give this a try...

CODE

'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,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Centrally documenting excel connection strings from multiple workbooks

(OP)
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:

CODE -->

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 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close