VBA Snippets

WbkDatabase_ConnectionOpen

Public Function WbkDatabase_ConnectionOpen(sFolderPath As String, _
                                           sWkbName As String, _
                                           Optional sExtension As String = ".xls", _
                                           Optional bInformUser As Boolean = True) As Boolean
Dim sConnectionStr As String
   On Error GoTo AnError
   Application.StatusBar = "Trying to connect to the " & sWkbName & "..."
   WbkDatabase_ConnectionOpen = True
   Set gobjADOConnect = New ADODB.Connection
   sConnectionStr = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
                    "DRIVERID=790;" & _
                    "READONLY=True;" & _
                    "DBQ=" & sFolderPath & sWkbName & sExtension & ";"
   If gobjADOConnect.State = adStateClosed Then
      gobjADOConnect.CursorLocation = ADODB.adUseClient
      gobjADOConnect.Open sConnectionStr, _
                        adConnectUnspecified
   End If
   Application.StatusBar = False
   If gbDEBUG = False Then Exit Function
AnError:
   WbkDatabase_ConnectionOpen = False
   Application.StatusBar = False
   If bInformUser = True Then _
   Call Error_Handle("WbkDatabase_ConnectionOpen", msMODULENAME, 1, _
          "create a connection to the workbook" & vbCrLf & _
           sFolderPath & sWkbName & sExtension)
End Function

WbkDatabase_SheetFillRecordset

Public Sub WbkDatabase_SheetFillRecordset(sWshName As String)
   On Error GoTo AnError
   Set gobjADOCommand = New ADODB.Command
   gobjADOCommand.CommandText = "SELECT * FROM [" & sWshName & "$]"
   gobjADOCommand.CommandType = adCmdText
   gobjADOCommand.ActiveConnection = gobjADOConnect
   
   Set gobjADORecordSet = New ADODB.Recordset
   Set gobjADORecordSet = gobjADOCommand.Execute
   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle("WbkDatabase_SheetFillRecordset", msMODULENAME, 1, _
          "obtain the recordset containing all the data on the sheet """ & sWshName & """")
End Sub

WbkDatabase_SQLReturnWshs

Public Function WbkDatabase_SQLReturnWshs() As String
Dim vtemparray As Variant
Dim larrayno As Long
Dim sconcat As String
   On Error GoTo AnError
   Set dbADORecordSet = New ADODB.Recordset
   Set dbADORecordSet = dbADOConnect.OpenSchema(adSchemaTables)

   Call Database_ResultsToArray(vtemparray, False)
      
   sconcat = ""
   For larrayno = LBound(vtemparray, 2) To UBound(vtemparray, 2)
      sconcat = sconcat & vtemparray(3, larrayno) & ";"
   Next larrayno
   
   WbkDatabase_SQLReturnWshs = Left(sconcat, Len(sconcat) - 1)
   If gbDEBUG = False Then Exit Function
AnError:
   Call Error_Handle("Wbk_SQLReturnWshs", msMODULENAME, 1, _
        "")
End Function