Hente data i et excel recordset

Eks. på kode i Word (This Document)
Filerne kan evt. blive tilsendt (mailadr. under profil)

Rem Ref. t/Microsoft Excel 11.0 Object Library (Tools / References) skal sættes
Rem ===========================================================
Rem
Const filnavnXLS = "adresser.xls"
Const startRækXls = 2
Dim adrXLS
Dim sti
Private Sub test()
    sti = findSti
    åbnAdresseFilen
    hentAdresser
    lukAdresseFilen
End Sub
Private Function findSti()
    findSti = ActiveDocument.Path
    If Right(findSti, 1) <> "\" Then
        findSti = findSti + "\"
    End If
End Function
Private Sub åbnAdresseFilen()
    Set adrXLS = CreateObject("Excel.Application")
    With adrXLS
        .Workbooks.Open sti + filnavnXLS
    End With
End Sub
Private Sub hentAdresser()
Dim navn As String, adresse As String, postnr As String
Dim Meddelelse As String
    Meddelelse = ""
   
    With adrXLS.ActiveWorkbook.Sheets(1)
        For ræk = startRækXls To 65000
            If .Cells(ræk, 1) = "" Then
                Exit For
            Else
                navn = .Cells(ræk, 1)
                adresse = .Cells(ræk, 2)
                postnr = .Cells(ræk, 3)
               
                Meddelelse = Meddelelse + navn + vbTab + adresse + vbTab + postnr + vbCr
               
            End If
        Next ræk
    End With
   
    MsgBox Meddelelse
End Sub
Private Sub lukAdresseFilen()
    adrXLS.Application.Quit
    Set adrXLS = Nothing
End Sub

Det ville være fint hvis du sender dem

Hvis du sender en mail til mig (adr. under profil) så returnerer jeg filerne.

Skal vi lukke ??? Smid et svar

Du får svar..