rivate Sub Exportieren()
On Error Resume Next
Dim s$, pfad$
Dim r As dao.Recordset
Dim r1 As dao.Recordset
Dim Datum As Date
Dim path$, file$, ext$
Dim pic As Variant
 
pfad = "c:\News_" & CStr(Date) & "\"
MkDir pfad
 
Set r = Data1.Recordset.Clone
r.Sort = "Datum Desc"
 
ProgressBar1.Max = r.RecordCount
While Not r.EOF
   ProgressBar1.Value = r.AbsolutePosition
   pfad = "c:\News_" & CStr(Date) & "\" & r("Rubrik") & "\"
   MkDir pfad   ' Politik, Deutschland etc.
'Musste ein bischen rausnehmen
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ''''''''''''''
''Musste ein bischen rausnehmen
  Datum = r1("datum")
  Print #1, "<tr>"
  Print #1, "<td width=""100%"" align=""left"">"
  Print #1, "<a href=""" & Format(r1("id"), "00000000") & ".htm" & """>"
  Print #1, "<font face=""Arial"""
  Print #1, "size=""2"">" & r1("Titel") & "</font></a></td>"
  Print #1, "</tr>"
  r1.MoveNext
Wend
 
Print #1, "</table>"
Print #1, "</body>"
Print #1, "</html>"
Close #1
 
r1.Close
 
 
 
  r.MoveNext
 
 
 
Wend
 
 
 
 
MsgBox "FERTIG, Die Daten liegen in " & "c:\News_" & CStr(Date) & "\"
 
 
 
End Sub