Office: VBA zur realisierung Import RTF Hilfe !!!

Hallo ich habe diesen Code im Internet gefunden der funktioniert auch aber :

Sub EinlesenRTF()
Dim wdApp As Object
Dim wdDoc As Object
Dim sFile As String
sFile = "C:\Dokumente und Einstellungen\st\Desktop\RTF\INVOICE-666451.RTF"
If Dir(sFile) = "" Then
MsgBox "Datei wurde nicht gefunden!"
Else
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
Set wdDoc = wdApp.Documents.Open(sFile)
wdApp.Selection.WholeStory
wdApp.Selection.Copy
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
ActiveSheet.Paste
End If
End Sub


Was muss ich hier ändern das ich gefragt werde wo die Datei liegt ? also ohne festen Pfad.

Und kann ich die Funktion hinter einen Button legen.

Ein Super User hatte mir schoneinmal dabei geholfen aber ich kann den Beitrag nicht mehr öffnen also hoffe ich sehr auf Eure Unterstützung !

Danke

 

Hi,

versuche es mal so:

Code:

Sub DateiOeffnen()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim sFile As String
    Dim fdDialog As FileDialog
    Set fdDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fdDialog
        .Filters.Clear
        .Filters.Add "RTF-Dateien", "*.rtf", 1
        If .Show = -1 Then
            sFile = .SelectedItems(1)
            Set wdApp = CreateObject("Word.Application")
            wdApp.Visible = False
            Set wdDoc = wdApp.Documents.Open(sFile)
            wdApp.Selection.WholeStory
            wdApp.Selection.Copy
            wdApp.Quit
            ActiveSheet.Paste
            Set wdDoc = Nothing
            Set wdApp = Nothing
        End If
    End With
    Set fdDialog = Nothing
End Sub

Bis später,
Karin

 

Super Klasse Danke

Kannst Du mir noch etwas helfen weil ich voll am ANfang stehe damit wier kannden das unter einen Button legen den ich in Excel einfüge

Danke

 

Hi,

schreibe den Code in ein allgemeines Modul, erstelle dann eine Schaltfläche aus der Formularsymbolleiste und weise das Makro dieser Schaltfläche zu (dies wird beim Erstellen abgefragt und du musst nur den Namen der Sub auswählen)

Bis später,
Karin

 

Hi Danke das habe ich hinbekommen jetzt kommt ein Fehler

:

Die Paste Methode sea Worksheet Objekts konnte nicht ausgeführt werden


Im Debugger markiert Er


ActiveSheet.Paste

 

Hi,

ich habe an deinem Ursprungscode (den habe ich nicht getestet weil ich nach deinen Worten annahm, dass er funktioniert - was aber offensichtlich nicht der Fall ist) in diesem Teil nichts geändert, sondern ihn nur um das Aufrufen des Datei-Öffnen-Dialogs ergänzt.

Ergänze vor der Zeile mit dem Fehler diese Zeile:

Code:

            Windows(ThisWorkbook.Name).Activate

Bis später,
Karin

 

Hi Katrin

Danke dafür er fügt es jetzt ein aber immer noch kommt der Laufzeitfehler das die Paste methode des Worksheet Objekts nicht ausgeführt werden kann.

Ich bin ratlos

Danke für deinen Support :-)

 

Hi,

Code:

Sub DateiOeffnen()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim sFile As String
    Dim fdDialog As FileDialog
    Set fdDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fdDialog
        .Filters.Clear
        .Filters.Add "RTF-Dateien", "*.rtf", 1
        If .Show = -1 Then
            sFile = .SelectedItems(1)
            Set wdApp = CreateObject("Word.Application")
            wdApp.Visible = False
            Set wdDoc = wdApp.Documents.Open(sFile)
            wdApp.Selection.WholeStory
            wdApp.Selection.Copy
            ActiveSheet.Paste
            wdApp.Quit
            Set wdDoc = Nothing
            Set wdApp = Nothing
        End If
    End With
    Set fdDialog = Nothing
End Sub

Bis später,
Karin

 

Der Hammer

Vielen Vielen Dank

super

Grüsse