[VB6] Esportazione XLS causa errore DataGrid

[StegcO]

Partiamo dal codice:

Private Sub Form_Load()

Dim SQL As String

Set Conn = New ADODB.Connection
Set Rs = New ADODB.Recordset
StringaConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\database.mdb;Persist Security Info=False"
Conn.Open StringaConn



SQL = "SELECT ID,Cognome,Societa,Telefono_1 FROM Agenda ORDER BY ID"
    
With Rs
    .ActiveConnection = Conn
    .CursorLocation = adUseServer
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Properties("IRowsetIdentity") = True
    .Open SQL, , , , adCmdText
End With

Set dgr_agenda.DataSource = Rs

dgr_agenda.Columns(0).Width = 500
dgr_agenda.Columns(1).Width = 2000
dgr_agenda.Columns(2).Width = 2000
dgr_agenda.Columns(3).Width = 1500

dgr_agenda.MarqueeStyle = 3

End Sub

Private Sub cmd_excel_Click()

Dim i As Integer
Dim SQL As String
Set Rs = New ADODB.Recordset

Dim ExcelApp As Excel.Application
Dim ExcelBook As Workbook

MsgBox "Esportazione in Excel effettuata.", vbOKOnly, "Avviso"

Set Rs = Conn.Execute("SELECT * FROM Agenda")

Rem Set ExcelApp = CreateObject("Excel.Application")
Set ExcelApp = New Excel.Application

ExcelApp.Application.Visible = True

Set ExcelBook = ExcelApp.Workbooks.Add
    
With ExcelApp.Application
    .Range("A1", "L1").Select
    .Selection.Interior.ColorIndex = 35

    .Cells(1, 1).Value = "ID"
    .Cells(1, 2).Value = "Società"
    .Cells(1, 3).Value = "Nome"
    .Cells(1, 4).Value = "Cognome"
    .Cells(1, 5).Value = "Indirizzo"
    .Cells(1, 6).Value = "Città"
    .Cells(1, 7).Value = "Telefono (1)"
    .Cells(1, 8).Value = "Telefono (2)"
    .Cells(1, 9).Value = "Cellulare"
    .Cells(1, 10).Value = "Fax"
    .Cells(1, 11).Value = "E-Mail"
    .Cells(1, 12).Value = "Note"

    i = 2
    Do While Not Rs.EOF
    
        .Cells(i, 1).Value = Rs.Fields("ID").Value
        .Cells(i, 2).Value = Rs.Fields("Societa").Value
        .Cells(i, 3).Value = Rs.Fields("Nome").Value
        .Cells(i, 4).Value = Rs.Fields("Cognome").Value
        .Cells(i, 5).Value = Rs.Fields("Indirizzo").Value
        .Cells(i, 6).Value = Rs.Fields("Citta").Value
        .Cells(i, 7).Value = Rs.Fields("Telefono_1").Value
        .Cells(i, 8).Value = Rs.Fields("Telefono_2").Value
        .Cells(i, 9).Value = Rs.Fields("Cellulare").Value
        .Cells(i, 10).Value = Rs.Fields("Fax").Value
        .Cells(i, 11).Value = Rs.Fields("Mail").Value
        .Cells(i, 12).Value = Rs.Fields("Notes").Value
        
        i = i + 1
        
    Rs.MoveNext
    Loop

    .Cells(1, 1).Select
    ExcelApp.Selection.HorizontalAlignment = xlCenter
End With

ExcelApp.Quit
Set ExcelApp = Nothing
Set ExcelBook = Nothing

End Sub

fin qui tutto bene, il problema nasce quando voglio aprire i dettagli del record:

Private Sub dgr_agenda_dblClick()

ID_Agenda = Rs.Fields("ID").Value
frm_agenda_dettaglio.Show

End Sub

DOPO aver fatto l'esportazione, è come se sballasse l'acquisizione dell'ID Record.

Avete idea di come risolvere? Refresh? RIcaricare la datagrid?

Grazie

[StegcO]

nessuna idea?