Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bei Import Teile des Dateinamens auslesen und in Zellen schreiben

Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 07:03:09
molch75
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ß
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 08:19:05
Regina
Hallo,
poste doch mal den Code, mit dem Du die Daten ausliest. dann kann man schauen, wo man ansetzen könnte.
Gruß
Regina
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 08:39:43
molch75
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ß
Anzeige
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 08:56:37
Regina
... 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
Anzeige
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 09:15:42
molch75
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ß
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 09:21:30
Regina
...oh, sorry... setze vor die 3 Range Zeilen mal einen Punkt:
.Range("A1") = Left....
Gruß Regina
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 09:49:52
molch75
Hab ich versucht, geht aber leider auch nicht.
Gruß
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 10:05:11
Torsten
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
Anzeige
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 10:43:41
molch75
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ß
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 10:52:11
Torsten
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
Anzeige
AW: Bei Import Teile des Dateinamens auslesen und in Zellen schreiben
24.01.2020 12:11:47
molch75
Es funktioniert :D
Vielen Dank an Euch!
Gruß
gerne...
24.01.2020 12:14:19
Torsten
...

376 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige