Microsoft Excel

Herbers Excel/VBA-Archiv

Bei Import Teile des Dateinamens auslesen und in Zellen schreiben

Betrifft: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben von: molch75
Geschrieben am: 24.01.2020 07:03:09

Guten Morgen zusammen,

ich kopiere mit einem Makro Daten aus der – geschlossenen - Datei: XXXXX_YYYYY_Z_0000_00000_00000_00000.xls in die Datei Master, nun möchte ich während des Imports teile des Dateinamens XXXXX_YYYYY_Z_0000_00000_00000_00000.xls auslesen und in die Datei Master in die Zellen A1, A3 und A4 schreiben.


Sollte dann so aussehen:

A1 = XXXXX

A3= YYYYY

A4= Z


Ist so etwas möglich?


Gruß

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: Regina Resch-Jansen
Geschrieben am: 24.01.2020 08:19:05

Hallo,
poste doch mal den Code, mit dem Du die Daten ausliest. dann kann man schauen, wo man ansetzen könnte.

Gruß
Regina

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: molch75
Geschrieben am: 24.01.2020 08:39:43

Hallo,

anbei der Code:

Option Explicit
Public Sub Import()

    Dim objWorkbook As Workbook
    Dim objTargetSheet As Worksheet
    Dim lngEmptyRow As Long

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set objTargetSheet = ThisWorkbook.Worksheets("Tabelle1") 

    With objTargetSheet
        lngEmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    End With

    Set objWorkbook = Workbooks.Open(Filename:= _
        "C:\Users\Name\Documents\Excel\XXXXX_YYYYY_Z_0000_00000_00000_00000.xls", ReadOnly:= _
True)

    With objWorkbook.Worksheets("Report") 

        Call .Range("F5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 1))
        Call .Range("B5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 2))
        Call .Range("D5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 3))
        Call .Range("F8").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 4))
        Call .Range("B14:B104").Copy
        Call objTargetSheet.Cells(lngEmptyRow, 5).PasteSpecial( _
            Paste:=xlPasteAll, Transpose:=True)

    End With
    
        
    Application.CutCopyMode = False

    Call objWorkbook.Close(SaveChanges:=False)

    Set objWorkbook = Nothing
    Set objTargetSheet = Nothing

    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    End Sub
Mir fällt allerdings gerade ein, der Dateiname XXXXX_YYYYY_Z_0000_00000_00000_00000.xls wird sich öfters an den besagten stellen ändern, sprich an den Stellen XXXXX_YYYYY_Z.
Deshalb währe es von Vorteil wenn ich eine Möglichkeit hätte die entsprechende Datei auszuwählen und gleichzeitig den Dateinamen auszulesen.

Gruß

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: Regina Resch-Jansen
Geschrieben am: 24.01.2020 08:56:37

... dann teste mal so:
Public Sub Import()

    Dim objWorkbook As Workbook
    Dim objTargetSheet As Worksheet
    Dim lngEmptyRow As Long
    Dim str_dateiname As String
    Dim fld As FileDialog

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set objTargetSheet = ThisWorkbook.Worksheets("Tabelle1")

    With objTargetSheet
        lngEmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    End With
    
    Set fld = Application.FileDialog(msoFileDialogFilePicker)

    If fld.Show <> -1 Then
        Exit Sub
    Else
        str_dateiname = fld.SelectedItems(1)
    End If
    
    Set objWorkbook = Workbooks.Open(str_dateiname, ReadOnly:=True)

    With objWorkbook.Worksheets("Report")
        Range("A1") = Left(objWorkbook.Name, 5)
        Range("A2") = Mid(objWorkbook.Name, 7, 5)
        Range("A3") = Mid(objWorkbook.Name, 13, 1)
        Call .Range("F5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 1))
        Call .Range("B5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 2))
        Call .Range("D5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 3))
        Call .Range("F8").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 4))
        Call .Range("B14:B104").Copy
        Call objTargetSheet.Cells(lngEmptyRow, 5).PasteSpecial( _
            Paste:=xlPasteAll, Transpose:=True)

    End With
    
        
    Application.CutCopyMode = False

    Call objWorkbook.Close(SaveChanges:=False)

    Set objWorkbook = Nothing
    Set objTargetSheet = Nothing

    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    End Sub
Gruß Regina

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: molch75
Geschrieben am: 24.01.2020 09:15:42

Danke für Deine schnelle Antwort, die Datei kann ich nun auswählen, leider bleiben aber die Zellen A1 - A3 leer.

Hab das hier mal für Versuchszwecke ausgeblendet:

' Call .Range("F5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 1))
' Call .Range("B5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 2))
' Call .Range("D5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 3))

Gruß

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: Regina Resch-Jansen
Geschrieben am: 24.01.2020 09:21:30

...oh, sorry... setze vor die 3 Range Zeilen mal einen Punkt:
.Range("A1") = Left....

Gruß Regina

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: molch75
Geschrieben am: 24.01.2020 09:49:52

Hab ich versucht, geht aber leider auch nicht.

Gruß

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: Torsten
Geschrieben am: 24.01.2020 10:05:11

Hallo,

du schreibst das ja in das ObjektWorkbook. Du willst ja aber die Teile des Namens in das Masterworkbook schreiben (also das Workbook, wo der Code steht).
Die Zeilen so:
ThisWorkbook.Sheets("Tabelle1").Range("A1") = Left(objWorkbook.Name, 5)
ThisWorkbook.Sheets("Tabelle1").Range("A3") = Mid(objWorkbook.Name, 7, 5)
ThisWorkbook.Sheets("Tabelle1").Range("A4") = Mid(objWorkbook.Name, 13, 1)

Den Tabellennamen musst du noch anpassen.

Gruss Torsten

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: molch75
Geschrieben am: 24.01.2020 10:43:41

So geht's :)

Was ich allerdings nicht bedacht habe, mein Makro schreibt ja die Daten aus der Datei immer in die nächste freie Zeile und mein Dateiname wäre jetzt immer in den festgelegten Zellen A2, B2 und C2, der Name soll sich ja aber immer mit in die nächste freie Zeile schreiben.

Sorry für den Umstand.

Gruß

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: Torsten
Geschrieben am: 24.01.2020 10:52:11

Hallo,

dann versuchs mal so:
Public Sub Import()
     
         Dim objWorkbook As Workbook
         Dim objTargetSheet As Worksheet
         Dim lngEmptyRow As Long, lngLast As Long
         Dim str_dateiname As String
         Dim fld As FileDialog
     
         With Application
             .Calculation = xlCalculationManual
             .EnableEvents = False
             .ScreenUpdating = False
         End With
     
         Set objTargetSheet = ThisWorkbook.Worksheets("Tabelle1")
     
         With objTargetSheet
             lngEmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
         End With
         
         Set fld = Application.FileDialog(msoFileDialogFilePicker)
     
         If fld.Show <> -1 Then
             Exit Sub
         Else
             str_dateiname = fld.SelectedItems(1)
         End If
         
         Set objWorkbook = Workbooks.Open(str_dateiname, ReadOnly:=True)
         
         With ThisWorkbook.Sheets("Tabelle1")       'Tabelle anpassen
             lngLast = .Cells(Rows.Count, 1).End(xlUp).Row
             .Cells(lngLast + 1, 1) = Left(objWorkbook.Name, 5)
             .Cells(lngLast + 1, 2) = Mid(objWorkbook.Name, 7, 5)
             .Cells(lngLast + 1, 3) = Mid(objWorkbook.Name, 13, 1)
         End With
     
         With objWorkbook.Worksheets("Report")
             Call .Range("F5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 1))
             Call .Range("B5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 2))
             Call .Range("D5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 3))
             Call .Range("F8").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 4))
             Call .Range("B14:B104").Copy
             Call objTargetSheet.Cells(lngEmptyRow, 5).PasteSpecial( _
                 Paste:=xlPasteAll, Transpose:=True)
     
         End With
         
             
         Application.CutCopyMode = False
     
         Call objWorkbook.Close(SaveChanges:=False)
     
         Set objWorkbook = Nothing
         Set objTargetSheet = Nothing
     
         With Application
             .Calculation = xlCalculationAutomatic
             .EnableEvents = True
             .ScreenUpdating = True
         End With
End Sub

Gruss Torsten

Betrifft: AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
von: molch75
Geschrieben am: 24.01.2020 12:11:47

Es funktioniert :D

Vielen Dank an Euch!

Gruß

Betrifft: gerne...
von: Torsten
Geschrieben am: 24.01.2020 12:14:19

...

Beiträge aus dem Excel-Forum zum Thema "Bei Import Teile des Dateinamens auslesen und in Zellen schr"