Sub MailExport()
 Dim strname As String
 Dim cPath As String
 
 ' cPath = "F:\Data\User\BS\ADRESSEN\IMPORT\"
 cPath = "\\SERVER\BS\ADRESSEN\IMPORT\"
  
 Set myItem = Application.ActiveInspector
  
  If Not TypeName(myItem) = "Nothing" Then
      Set objitem = myItem.CurrentItem
      strname = URLEncode(Left(objitem.Subject, 60))
      strname = strname & URLEncode(" [" & objitem.SenderEmailAddress & " (" & objitem.SentOn & ")]")
      objitem.SaveAs cPath & strname & ".msg", olMSG
      objitem.FlagStatus = olFlagComplete
      objitem.FlagIcon = olGreenFlagIcon
      objitem.Save
      ' objitem.Send
  Else
      MsgBox "Es ist keine Mail geöffnet, die gespeichert werden könnte."
  End If

End Sub


Function URLEncode(Str As String) As String
  Dim i As Integer
  Dim nAsc As Integer
  
  URLEncode = Str
  For i = Len(URLEncode) To 1 Step -1
    nAsc = Asc(Mid$(URLEncode, i, 1))
    Select Case nAsc
      Case 48 To 57, 65 To 90, 97 To 122
      Case Asc(" ")
      Case Asc("(")
      Case Asc(")")
      Case Asc("[")
      Case Asc("]")
      Case Asc(".")
      'Case 32
      '  Mid$(URLEncode, i, 1) = "+"
      Case Else
        URLEncode = Left$(URLEncode, i - 1) & _
         "%" & Hex$(nAsc) & Mid$(URLEncode, i + 1)
    End Select
  Next
End Function