Need help modifying DSNStripper code to Oracle

KevCB226

Registered User.
Local time
Today, 14:05
Joined
Oct 20, 2005
Messages
24
Hi

I found the DSNStripper add-in on mvps, nice little tool.
But I would like to try and get it to work with linked tables from Oracle and make them DSN-less.

Can anyone give me any suggestions on how to do this?
I don't really understand how the code works, but I have changed what I think are the sections that will work for Oracle, but I keep getting the following message when I add it into the db I'm working on and running it.

View Message

However, if I run the original code to change the tables from SQL Server to DSN-less it works fine.

Is there anything wrong with my code, which could cause this message?

Code:

Code:
Option Compare Database
Option Explicit

Const strSupportTable As String = "USysDSNStripper"

Private Sub cmdHelp_Click()
   MsgBox "This utility will iterate through your ODBC linked tables and convert the links to DSN-less links. It assumes that all ODBC links are to the above-named SQL Server. Do NOT use if you have ODBC links to databases other than SQL Server.", _
    vbInformation + vbOKOnly, "DSN Stripper 4 Oracle"
End Sub

Private Sub cmdStrip_Click()

   On Error GoTo HandleErrors

   If Len(txtServer & "") > 0 Then
      ServerSave txtServer.Value
            
      Dim db As DAO.Database
      Dim tdf As DAO.TableDef
      Dim strCnx As String
      Dim strName As String
      Dim intPosDsn As Integer
      Dim intPosNextSemi As Integer
      Dim astrCnx(3) As String
      Dim strMsg As String
      Dim strAOName As String
      
      Set db = CurrentDb()
      
      For Each tdf In db.TableDefs
          If Not tdf.Name Like "MSys*" And Not tdf.Name Like "USys*" Then
              strName = tdf.Name
              lblProgress.Caption = "Inspecting " & strName & "..."
              Me.Repaint
            
              strCnx = tdf.Connect
              
              If Len(strCnx) > 0 Then
                If Left(strCnx, 5) = "ODBC;" Then
                  lblProgress.Caption = "Converting link for " & strName & "..."
                  Me.Repaint
                  
                  intPosDsn = InStr(strCnx, ";DSN=")
                  If intPosDsn > 0 Then
                     intPosNextSemi = InStr(intPosDsn + 1, strCnx, ";")
                     
                     
                     astrCnx(1) = Left(strCnx, intPosDsn - 1)
                     astrCnx(2) = ";DRIVER=Microsoft ODBC for Oracle;SERVER=" & txtServer.Value
                     astrCnx(3) = Mid(strCnx, intPosNextSemi)
                     strCnx = astrCnx(1) & astrCnx(2) & astrCnx(3)
                     
                     ' Now refresh the link
                     tdf.Connect = strCnx
                     tdf.RefreshLink
                  End If
              
                End If
              End If
              
          End If

      Next
      
      lblProgress.Caption = "Done."
      Me.Repaint
   Else
      MsgBox "In order to perform the conversion you must supply the Oracle Server name.", vbCritical + vbOKOnly, _
       "DSN Stripper 4 Oracle"
   End If
   
ExitHere:
     On Error Resume Next
     Exit Sub
   
HandleErrors:
     Select Case Err.Number
       Case Else
         strMsg = "Unexpected error " & Err.Number & ": " & vbCrLf & Err.Description
     End Select
     MsgBox strMsg, vbCritical + vbOKOnly, "Itemize Database Error"
     Resume ExitHere
End Sub

Private Sub Form_Load()
   txtServer.Value = ServerGet()
   
End Sub

Function ServerGet()
   Dim db As DAO.Database
   Dim rst As DAO.Recordset
   Dim strReturn As String
   
   On Error Resume Next
   
   Set db = CodeDb
   Set rst = db.OpenRecordset(strSupportTable, dbOpenTable)
   If Not rst.EOF Then
      strReturn = rst.Fields("ServerName")
   End If
   
   rst.Close
   
   ServerGet = strReturn
End Function

Sub ServerSave(strServer As String)
   Dim db As DAO.Database
   Dim rst As DAO.Recordset
   
   On Error Resume Next
   
   Set db = CodeDb
   Set rst = db.OpenRecordset(strSupportTable, dbOpenTable)
   If Not rst.EOF Then
      rst.Edit
         rst.Fields("ServerName") = strServer
      rst.Update
   Else
      rst.AddNew
         rst.Fields("ServerName") = strServer
      rst.Update
   End If
   
   rst.Close
End Sub

Thanks
 

Users who are viewing this thread

Back
Top Bottom