Public Function ExtractFileFromRAR( _
  RarFile As String, _
  FileToExtract As String, _
  Destination As String, _
  Optional Password As String = "")
 
  On Error GoTo fehler
 
  Dim lHandle As Long
  Dim iStatus As Integer
  Dim uRAR As RAROpenArchiveData
  Dim uHeader As RARHeaderData
  Dim sStat As String, Ret As Long
 
  With uRAR
    .ArcName = RarFile
    .CmtBuf = Space(16384)
    .CmtBufSize = 16384
 
    .OpenMode = RAR_OM_EXTRACT
 
    lHandle = RAROpenArchive(uRAR)
    If .OpenResult <> 0 Then OpenError .OpenResult, RarFile
 
    If Password <> "" Then RARSetPassword lHandle, Password
 
    If (.CmtState = 1) Then MsgBox .CmtBuf, vbApplicationModal + vbInformation, _
      "Comment"
 
    iStatus = RARReadHeader(lHandle, uHeader)
 
    With uHeader
      Do
        sStat = Left$(.FileName, InStr(1, .FileName, vbNullChar) - 1)
        ' MsgBox sStat & vbLf & FileToExtract
        If InStr(1, sStat, FileToExtract, vbTextCompare) <> 0 Or _
          FileToExtract = "" Then
          Ret = RARProcessFile(lHandle, RAR_EXTRACT, "", Destination & "\" & _
          .FileName)
          If Not FileToExtract = "" Then
            RARCloseArchive lHandle
            Exit Function
          End If
        Else
          Ret = RARProcessFile(lHandle, RAR_SKIP, "", "")
        End If
 
        If Ret = 0 Then
          ' Wenn kein Fehler aufgetreten ist
          frmdlneu.Refresh
        Else
          ProcessError Ret
        End If
 
        RARReadHeader lHandle, uHeader
        iStatus = iStatus + 1
      Loop
    End With
 
  End With
  If iStatus = ERAR_BAD_DATA Then Erro ("File header broken")
 
  RARCloseArchive lHandle
  Exit Function
 
fehler:
  RARCloseArchive lHandle
End Function