Hente flere data fra Access

Og her var så koden:

Sub HentDataTilLabels(TargetCell As Range)
Dim DB As Database
Dim Rs As Recordset
Dim Ws As Worksheet
Dim Path As String
Set Ws = ActiveSheet
Dim sqlstr As String
Dim tmp As String
Dim Navn As String
     
     
  Path = "\\Hjertesrv\faelles\Registre\Patientregisteret.mdb"
   
  'Her indsættes navn og sti
  tmp = Chr(34) & TargetCell.Value & Chr(34)

  sqlstr = "SELECT * FROM [Kartotek] WHERE [Patient nr] BETWEEN " & tmp & ";"

  Set DB = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)
  On Error GoTo notfound
  Set Rs = DB.OpenRecordset(sqlstr)
 
  With TargetCell
    .Offset(0, 0) = Rs.Fields("Patient nr")
    .Offset(0, -4) = Rs.Fields("Fornavn") & " " & Rs.Fields("Efternavn")
    .Offset(0, -2) = Rs.Fields("CPR nr")
    .Offset(0, 16) = Rs.Fields("Indkaldelse Dato")
    .Offset(0, 18) = Rs.Fields("Adresse")
    .Offset(0, 20) = Rs.Fields("Postnr og bynavn")
  End With

  Rs.Close
  DB.Close
  Set DB = Nothing
  Set Rs = Nothing
  Exit Sub

notfound:
  Rs.Close
  DB.Close
  Set DB = Nothing
  Set Rs = Nothing
  MsgBox "Ingen poster fundet"
End Sub

Kan du ikke lige uddybe det lidt ?
Så vidt jeg husker er den en tom række mellem hver af dine patientoplysninger. Er det stadig rigtigt?
Hvis du vil køre BETWEEN får du jo en lang række med mindre vi tager højde for det.

Underforstået at du mener i det modtagende ark skal det stå jvf ovenstående Offset blot med en patient pr række.
De skal anvendes i en situation hvor sekretæren ønsker at udskrive labels på flere patienter på en gang (selekteret udfra patient nr). Den Liste som du tidligere har lavet til mig og som fungerer perfekt kan desværre kun være en patient af gangen.
Between: Begrænses den ikke af de numre man taster ind: Mellem R03010-R03020 (11 stk?)

Korrektion: Den Liste som du tidligere har lavet til mig og som fungerer perfekt kan desværre kun selektere en patient af gangen.

Her er et bud. Betragt det ikke som en hel løsning

Sub HentDataTilLabels(TargetCell As Range)
Dim DB As Database
Dim Rs As Recordset
Dim Ws As Worksheet
Dim Path As String
Set Ws = ActiveSheet
Dim sqlstr As String
Dim tmp As String
Dim Navn As String
     
     
  Path = "\\Hjertesrv\faelles\Registre\Patientregisteret.mdb"
   
  'Her indsættes navn og sti
  tmp = Chr(34) & TargetCell.Value & Chr(34)
  tmp2 = "?????"

  sqlstr = "SELECT * FROM [Kartotek] WHERE [Patient nr] BETWEEN " & tmp & " AND " & tmp2 & " ;"

  Set DB = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)
  On Error GoTo notfound
  Set Rs = DB.OpenRecordset(sqlstr)
  Do Until Rs.BOF
    With TargetCell
      x = x + 1
      .Offset(x, 0) = Rs.Fields("Patient nr")
      .Offset(x, -4) = Rs.Fields("Fornavn") & " " & Rs.Fields("Efternavn")
      .Offset(x, -2) = Rs.Fields("CPR nr")
      .Offset(x, 16) = Rs.Fields("Indkaldelse Dato")
      .Offset(x, 18) = Rs.Fields("Adresse")
      .Offset(x, 20) = Rs.Fields("Postnr og bynavn")
    End With
    Rs.MoveNext
  Loop

  Rs.Close
  DB.Close
  Set DB = Nothing
  Set Rs = Nothing
  Exit Sub

notfound:
  Rs.Close
  DB.Close
  Set DB = Nothing
  Set Rs = Nothing
  MsgBox "Ingen poster fundet"
End Sub

Kan der laves en Inputbox til indtastning af patientnumrene (rangen) - og så er x nødt til at starte fra række 70 - undskyld forvirringen :0(

Sub HentDataTilLabels(TargetCell As Range)
Dim DB As Database
Dim Rs As Recordset
Dim Ws As Worksheet
Dim Path As String
Set Ws = ActiveSheet
Dim sqlstr As String
Dim tmp As String
Dim tmp2 As String
Dim Navn As String
     
     
  Path = "\\Hjertesrv\faelles\Registre\Patientregisteret.mdb"
   
  'Her indsættes navn og sti
  tmp = InputBox("Fra")
  tmp2 = InputBox("Til")

  sqlstr = "SELECT * FROM [Kartotek] WHERE [Patient nr] BETWEEN " & tmp & " AND " & tmp2 & " ;"

  Set DB = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)
  On Error GoTo notfound
  Set Rs = DB.OpenRecordset(sqlstr)
  x = 0
  Set TargetCell = Range("A70")
  Do Until Rs.BOF
    With TargetCell
      .Offset(x, 0) = Rs.Fields("Patient nr")
      .Offset(x, -4) = Rs.Fields("Fornavn") & " " & Rs.Fields("Efternavn")
      .Offset(x, -2) = Rs.Fields("CPR nr")
      .Offset(x, 16) = Rs.Fields("Indkaldelse Dato")
      .Offset(x, 18) = Rs.Fields("Adresse")
      .Offset(x, 20) = Rs.Fields("Postnr og bynavn")
      x = x + 1
    End With
    Rs.MoveNext
  Loop

  Rs.Close
  DB.Close
  Set DB = Nothing
  Set Rs = Nothing
  Exit Sub

notfound:
  Rs.Close
  DB.Close
  Set DB = Nothing
  Set Rs = Nothing
  MsgBox "Ingen poster fundet"
End Sub

Kan det lade sig gøre blot at kalde den fra en kommandoknap - så skal (Target as Range) vel væk eller hva'?

Ja, det kan du godt og rigtigt ..
det skal bare være Sub HentDataTilLabels()

Den laver desværre "vrøvl". Run-time error '91':
Object variable og with block variable not set.
Når man debugger viser den fejl ved: Rs.Close

Det skal lige siges at feltet Patient nr i Access er et textfelt og tilsvarende konfigureret i Excel

Altså - Rs.Close under notfound:

Når: On error goto not found inaktiveres og man "stepper" ind i makroen fejler den ved:
Set RS=DB.OpenRecordset(Sqlstr)
og skriver:
Run-time error '3463'
Datatyperne stemmer ikke overens i kriterieudtrykket

Nå ved at kigge på vba du tidl har lavet og mindre ændringved BOF --> EOF lykkedes det:

Sub HentDataTilLabels()
Dim DB As Database
Dim Rs As Recordset
Dim Ws As Worksheet
Dim Path As String
Set Ws = ActiveSheet
Dim sqlstr As String
Dim tmp As String
Dim tmp2 As String
Dim Navn As String
     
     
  Path = "\\Hjertesrv\faelles\Lotte og Susanne\Registre\Patientregisteret.mdb"
 
  Sheets("Ark1").Range("E70:CC2000").ClearContents
  Range("E70").Select

  tmp = InputBox("Fra")
  tmp2 = InputBox("Til")

  sqlstr = "SELECT * FROM [2003Union] WHERE [Patient nr] BETWEEN'" & tmp & "' AND '" & tmp2 & ";'"

  Set DB = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)
  On Error GoTo notfound
  Set Rs = DB.OpenRecordset(sqlstr)
  X = 0
  Set TargetCell = Range("I70")
  Do Until Rs.EOF
    With TargetCell
      .Offset(X, 0) = Rs.Fields("Patient nr")
      .Offset(X, -4) = Rs.Fields("Fornavn") & " " & Rs.Fields("Efternavn")
      .Offset(X, -2) = Rs.Fields("CPR nr")
      .Offset(X, 18) = Rs.Fields("Adresse")
      .Offset(X, 20) = Rs.Fields("Postnr og bynavn")
      X = X + 1
    End With
    Rs.MoveNext
  Loop

  Rs.Close
  DB.Close
  Set DB = Nothing
  Set Rs = Nothing
  Exit Sub

notfound:
  Rs.Close
  DB.Close
  Set DB = Nothing
  Set Rs = Nothing
  MsgBox "Ingen poster fundet"
End Sub

Tak for hjælpen Tommy - Svar lige så du kan få point  :0)

ok