Dim SQLConn As Object, Recordset As Object
    Dim i As Integer
    Set SQLConn = CreateObject("ADODB.Connection")
    SQLConn.CursorLocation = 3
    SQLConn.Open "Provider=Microsoft.Ace.OLEDB.12.0; Extended Properties=""Excel 12.0; HDR=Yes;""; Data Source=" & ActiveWorkbook.FullName
    Set Recordset = SQLConn.Execute("SELECT [TypeNum], [TypeStr] FROM [db$]")
    ReDim arr(Recordset.RecordCount - 1, Recordset.Fields.Count - 1)
    i = 0
    Do While Not Recordset.EOF
        arr(i, 0) = Recordset.Fields("TypeNum")
        arr(i, 1) = Recordset.Fields("TypeStr")
        i = i + 1
        Recordset.MoveNext
    Loop
    ThisWorkbook.Sheets("result").Cells(1, 1).Resize(Recordset.RecordCount, Recordset.Fields.Count) = arr

Data Source=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)(HOST=MyHost)(PORT=MyPort))(CONNECT_DATA=(SERVICE_NAME=MyOracleSID)));
User Id=myUsername;Password=myPassword

On Error Resume Next
Set oApp = CreateObject("Outlook.Application")
If oApp Is Nothing Then Exit Sub

Set Rng = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)).SpecialCells(xlVisible)
For Each r1 In Rng.Areas
    For Each r2 In r1
        Debug.Print r2
    Next r2
Next r1

Public Const ConnectionString As String = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=C:\database.accdb; Jet OLEDB:Database;"

Public path As String
Public Const ConnectionString As String = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & path & ";" & "Jet OLEDB:Database;"

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim a
    If ComboBox1 = "" Then Exit Sub
    a = ComboBox1
    If KeyCode = vbKeyReturn Then
        Call Find_Value(a & "*", Sheets("Data").Range("A:A"))
        ComboBox1.Activate
        ComboBox1.DropDown '???
    End If
End Sub

<TR class="TDRowColor1">
<TD>111.222.333</TD>
<TD>NAME</TD>
<TD>1</TD>
<TD>0</TD>
<TD>2</TD>
<TD>1111</TD>
<TD>2222</TD>
<TD>Deleted</TD>
<TD>Deleted</TD>
<TD>Deleted</TD></TR>

<TR class="TDRowColor1">
<TD>111.222.333</TD>

RegExp.Pattern = "class=""TDRowColor1""><TD>([0-9]+)</TD>"
bRes = RegExp.test(htmlcode)
If bRes Then
    Set oMatches = RegExp.Execute(htmlcode)
    Item.Num = oMatches(0).subMatches(0)
End If

   Set f = Intersect(Target, Range("A:A"))
    If f.Cells.Count > 1 Then Set f = f.SpecialCells(xlCellTypeConstants)
    If Not f Is Nothing Then
        For Each cell In f.Cells
            Application.StatusBar = "Поиск цены " & cell
                    If cell Like "######" Then
                    cell.Offset(, 5) = FindAndInsert(db, f, 0, 1)
                End If
            DoEvents
        Next cell
        Application.StatusBar = False
    End If

With GetQueryRange("http://")
       cell.Offset(, 1) = FindAndInsert(tmpSheet, "Date:", 0, 1)
End With