• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Save Ado Recordset to Excel File

Save Ado Recordset to Excel File

Save Ado Recordset to Excel File

Rate Save Ado Recordset to Excel File

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    Dim conS As String, strSql As String
    Dim aCon As New ADODB.Connection, idx As Integer
    
    conS = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                       "Data Source=" & fileName & ";" & _
                       "Extended Properties=""Excel 8.0;HDR=Yes;"";"
    aCon.ConnectionString = conS
    aCon.CursorLocation = adUseServer
    aCon.Mode = adModeShareExclusive
    Call aCon.Open
    
    
    strSql = "CREATE TABLE [" & tableName & "] ("
    For idx = 0 To aRec.Fields.Count - 1
        strSql = strSql & "[" & aRec.Fields(idx).Name & "] " & Me.GetAccessFieldType(aRec.Fields(idx))
        If (Me.GetAccessFieldType(aRec.Fields(idx)) = "TEXT") Then
            If aRec.Fields(idx).DefinedSize > 255 Then
                strSql = strSql & ", "
            Else
                strSql = strSql & " (" & aRec.Fields(idx).DefinedSize & ") ,"
            End If
        Else
            strSql = strSql & ", "
        End If

    Next idx
    strSql = Left(strSql, Len(strSql) - 2) & " )"
    Call aCon.Execute(strSql)
    Dim oRec As New ADODB.Recordset
    Set oRec.ActiveConnection = aCon
    oRec.CursorLocation = adUseClient
    oRec.LockType = adLockOptimistic
    oRec.CursorType = adOpenKeyset
    oRec.Source = "SELECT * FROM [" & tableName & "]"
    oRec.Open
    
    aRec.MoveFirst
    Do Until aRec.EOF
        oRec.AddNew
        For idx = 0 To aRec.Fields.Count - 1
            If Not IsNull(aRec.Fields(idx).Value) Then
                oRec.Fields(idx).Value = aRec.Fields(idx).Value
            End If
        Next idx
        aRec.MoveNext
        oRec.Update
    Loop
    aRec.MoveFirst
    oRec.Close
    Set oRec = Nothing
    aCon.Close
    Set aCon = Nothing
End Sub

Public Function GetAccessFieldType(ByRef oField As ADODB.Field) As String
    Dim strRez As String
    Select Case oField.Type
        Case adBSTR, adChar, adVarChar, adWChar, _
           adVarWChar, adLongVarChar, adLongVarWChar
            strRez = "TEXT"
        Case adBigInt, adNumeric, adInteger, _
            adSingle, adSmallInt, adTinyInt, adUnsignedBigInt, adUnsignedInt, _
            adUnsignedSmallInt, adUnsignedTinyInt
            strRez = "INTEGER"
        Case adDecimal, adDouble
            strRez = "DOUBLE"
        Case adSingle
            strRez = "SINGLE"
        Case adCurrency
            strRez = "CURRENCY"
        Case adBoolean
            strRez = "BIT"
        Case adDBTimeStamp, adDBTime
            strRez = "DATETIME"
    End Select
    GetAccessFieldType = strRez
End Function