Newsgroup: it.comp.lang.visual-basic
Titolo: esportare una tabella in excel via dbgrid (dao)

in questi giorni sembra serva parecchio, quindi riposto il codice.
salvare la parte qui sotto come form1.frm e inserire il form in un vb.
serve inoltre un db1.mdb con una tabella test_tab con qualche record.
riprovato adesso, funziona sia con il primo command (codice trovato: esporta
in xls ma xi vuole excel installato) che col secondo (lievemente ritoccato,
esporta in un file csv: ribattezzato d atab a csv dovrebbe essere visibile a
excel che pero' non e' richiesto).
timothy, ok se metto a posto il vbp e te lo mando per il s.c. ?
j.db2xl
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3945
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5220
   LinkTopic       =   "Form1"
   ScaleHeight     =   3945
   ScaleWidth      =   5220
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command1
      Caption         =   "Export DB to CSV (codice mio)"
      Height          =   495
      Left            =   660
      TabIndex        =   3
      Top             =   2040
      Width           =   3120
   End
   Begin ComctlLib.ProgressBar Bar1
      Align           =   2  'Align Bottom
      Height          =   300
      Left            =   0
      TabIndex        =   2
      Top             =   3645
      Width           =   5220
      _ExtentX        =   9208
      _ExtentY        =   529
      _Version        =   327682
      Appearance      =   1
   End
   Begin VB.CommandButton cmdExport
      Caption         =   "Export DB to XLS (codice internet)"
      Height          =   495
      Left            =   720
      TabIndex        =   0
      Top             =   420
      Width           =   3120
   End
   Begin VB.Label lblExport
      Caption         =   "lblExport"
      Height          =   495
      Left            =   180
      TabIndex        =   1
      Top             =   1260
      Width           =   4575
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub CmdExport_Click()
'This code exports a recordset to an excel spreadsheet
    Dim x
    Dim xlApp As Excel.Application
    Dim xlBook As Workbook
    Dim xl As Excel.Worksheet
    Dim icols
    Dim expDB As Database
    Dim rs As Recordset
    Dim FldCount As Integer
'    Dim rsCount As Integer
    Dim rsCount As Long
    Dim i, k, c, r
    x = MsgBox("This function will export the current records in the DBGrid
to an Excel sheet, " & _
        "If you do not have Excel an error will occur, do wish to
continue?", vbYesNo + vbQuestion, "Export Data?")
    If x = vbNo Then Exit Sub
    'If IsNull(tmpData.Recordset) Then GoTo NoRS
    Screen.MousePointer = vbHourglass
    'Access Your recordset here it is from as
    'Data control, it does not maatter where it
    'comes from.
    Dim lstDB As Database
    Set lstDB = OpenDatabase("db1.mdb")
    Set rs = lstDB.OpenRecordset("test_tab", dbOpenSnapshot)
    'Set rs = lstDB.OpenRecordset(tmpData.RecordSource, dbOpenSnapshot)
    'Declare application
    Set xlApp = CreateObject("Excel.Application")
    'Declare Workbook
    Set xlBook = xlApp.Workbooks.Add(xlWBATWorksheet)
    'Identify worksheet
    Set xl = xlBook.Worksheets(1)
    'Below this code determines the number of columns then
    'labels each column with the appropriate field name.
    'This code can be found in the 'CopyFromRecordSet' function
    'of the Excel Object.
    FldCount = rs.Fields.Count - 1
    'Excel Column counts are kept seperate as fields may be skipped
    c = 1
    For icols = 0 To rs.Fields.Count - 1
    'If the field is a system field then it skips it.
        If rs.Fields(icols).Name Like "s_" & Chr(42) Then GoTo SkipName
        xl.Cells(1, c).Value = rs.Fields(icols).Name
        c = c + 1
SkipName:
    Next
    xl.Range(xl.Cells(1, 1), xl.Cells(1, rs.Fields.Count)).Font.Bold = True
    With rs
        .MoveLast
        .MoveFirst
        rsCount = .RecordCount - 1
        r = 2
        Me.Height = 5970
        'Here I have a statusbar on my form
        Bar1.Min = 0
        Bar1.Max = rsCount
        lblExport.Visible = True
        Bar1.Visible = True
        '4 loops are being performed at once here.
        'Loop 'k' loops through the rows of records and
        'with each row 'r' for the Excel sheet.
        'Inside this loop is another nested loop.
        'Loop 'i' is looping through the Fields and along
        'with i 'c' is moving through the columns.
        'As mentioned above the reason for seperate counts
        'between the recordset and Excel sheet are due to
        'skipping system fields.
        For k = 0 To rsCount
            c = 1
            For i = 0 To FldCount
                If rs.Fields(i).Name Like "s_" & Chr(42) Then GoTo SkipField
                xl.Cells(r, c).Value = rs.Fields(i).Value
                c = c + 1
SkipField:
            Next 'i
            r = r + 1
            .MoveNext
            Bar1.Value = k
        Next 'k
    End With
    'After loop is complete, show the sheet
    xl.Visible = xlSheetVisible
    xlApp.Visible = True
    Bar1.Visible = False
    lblExport.Visible = False
    Me.Height = 5265
    xlApp.Quit
    Set xl = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Set rs = Nothing
    Screen.MousePointer = vbDefault
    Exit Sub
NoRS:
    Screen.MousePointer = vbDefault
    MsgBox "No Active recordset detected"
    Exit Sub
Exp_Err:
    Screen.MousePointer = vbDefault
    MsgBox Err.Number & ": " & Err.Description
    Resume Next
End Sub
Private Sub Command1_Click()
    Dim db As Database, rs As Recordset
    Dim fName As String, fNum As Integer
    Dim j As Long, f As Long, r As Long, c As Long, s As String
    Set db = OpenDatabase("db1.mdb")
    Set rs = db.OpenRecordset("test_tab", dbOpenSnapshot)
    'fName = App.Path & "\db1.csv"
    fName = App.Path & "\db1.tab"
    fNum = FreeFile
    Open fName For Output As #fNum
    With rs
        f = .Fields.Count - 1
        For j = 0 To f
            s = s & .Fields(j).Name & Chr(9)
        Next
        s = Left(s, Len(s) - 1)
        Print #fNum, s
        s = ""
        For j = 0 To f
            s = s & "riga1_" & CStr(j) & Chr(9)
        Next
        s = Left(s, Len(s) - 1)
        Print #fNum, s
        .MoveLast
        r = .RecordCount
        If r = -1 Then r = 0
        .MoveFirst
        While Not .EOF
            s = ""
            For j = 0 To f
                s = s & .Fields(j) & Chr(9)
            Next
            s = Left(s, Len(s) - 1)
            Print #fNum, s
            c = c + 1
            lblExport = c & " / " & r
            If c Mod 100 = 0 Then DoEvents
            .MoveNext
        Wend
    End With
    Close #fNum
    rs.Close: Set rs = Nothing
    MsgBox "ok"
End Sub


Very good.
Btw, sembra che sia l' "Argomento della settimana"...  :-)
ciao
ugo

 Btw, sembra che sia l' "Argomento della settimana"...  :-)
Oltre alla copia dei files aperti! :-)

Ciao, credo di aver messo tutte le librerie necessarie.
Perchè mi da errore:
Errore di run-time 13
Tipo non corrispondente
su:
Set rs = lstDB.OpenRecordset("NOMETABELLA", dbOpenSnapshot)
Grazie
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 Grazie
che mdb usi ? 97, 2000, xp ?
che riferimenti dao hai attivati ?
progetto | riferimenti

 progetto | riferimenti
Uso Access2000, VB6. Ho attivato:
Microsoft 
ActiveX DataObject 2.7 library
DAO 3.6 Object Library
Data Access Components Installed Version
Microsoft Excel 9.0 Object Library
Microsoft Office 9.0 Object Library


 Microsoft Office 9.0 Object Library
per quanto riguarda il codice che ho postato stamattina
-fai un nuovo vbp, non inserirlo su qc di gia' spaciugato, e inserisci solo
quel form1
- oltre ai vari vb/vba, nei rif attiva solo dao3.51 o dao3 ed excel9 (se usi
il primo command, col codice mio non serve).

FUNZIONA!!!!!!!
Ti ringrazio!!!
E l'ultima domanda...spero!!!!
Come faccio a ripulire un form dopo aver dato un comando...
ad esempio il comando ESPORTA?


 ad esempio il comando ESPORTA?
"ripulire" ?


iper-ROTFL...
qui in ufficio ci stiamo rotolando tutti... :-))))
ciao
ugo


ROTFL =)))))))
Lokar


Le cose vanno capite, non fatte a casaccio!
Ciao

 timothy, ok se metto a posto il vbp e te lo mando per il s.c. ?
Ok, manda...
Per i csv si potrebbe usare questa (autore anonimo):
Private Sub Save_Recordset(Filename As String, rs As Recordset)
    'Esporta i dati in formato .csv
    On Error Goto Save_RecordSet_Err
    Dim i, j As Integer
    Open Filename For Output As #1
    rs.MoveFirst
    For j = 0 To rs.RecordCount - 1
        Print #1, Chr(34) & Trim(rs.Fields(0)) & Chr(34);
        For i = 1 To rs.Fields.Count - 1
            Print #1, "," & Chr(34) & Trim(rs.Fields(i)) & Chr(34);
        Next i
        Print ""
        Print #1, Chr(13) & Chr(10);
        rs.MoveNext
    Next j
    Close #1
    Exit Sub
    Save_RecordSet_Err:
    If Err.Number = 76 Then
        Resume
    ElseIf Err.Number = 3021 Then
        Resume Next
    Else
        MsgBox Err.Number & " " & Err.Description, , _
            MsgCaption
    End If
    Close #1
End Sub
Ciao
--
Timothy Redaelli
timothy(dot)redaelli(at)email(dot)it
-----------------------------------
Links:
Sito Comune: 
www.it-lang-vb.net
MSDN: 
msdn.microsoft.com