Sub AutoUpload()
 
Dim objOL As Object
Set objOL = CreateObject("Outlook.Application")
Set objOL = New Outlook.Application
Set objNS = objOL.GetNamespace("MAPI")
 
Set objFolder = objNS.GetDefaultFolder(olPublicFoldersAllPublicFolders)
Set objOL = GetObject("\\Öffentliche Ordner\Alle öffentlichen" & _
  "Ordner\SC412\Mitfahrzentrale\Mitfahrzentrale", Outlook.olOrganizer)
  Set objOL = myItem.CurrentItem
      strname = objItem.Subject
objOL.SaveAs "F:\ts1home\dokumente\mitarbeiter\Mitfahrzentrale\ & strname &" & _
  ".html", olHTML
 
End Sub