Name der Datei in der Excel-Datei Zelle mit VBA

Question

Ich brauche eine VBA, wo es den "Namen der Excel-Datei" innerhalb dieser bestimmten "Excel-Datei" aktualisiert. Es gibt 12 Dateien im Ordner. Der Pfad für diesen Ordner lautet D: \ Amit. Name dieser 12 Dateien sind "Cash Report wie am 11-05-2017 0000Hrs" ab Mitternacht (deshalb 00:00 Uhr) und es erhöht sich um 2 Stunden, es 0200Hrs, 0400Hrs usw. machend. Wir bereiten diese Akten täglich nach alle 2 Stunden vor. Manchmal passiert es, dass wir die Datei nach 3 Stunden laufen lassen, um 05:00 Uhr anstelle von 04:00 Uhr kurz nach 02:00 Uhr zu machen. Was ich brauche, ist eine VBA-Datei, die alle diese 12 Dateien öffnet, und in Spalte A in der letzten Zeile der jeweiligen Datei wird der Name dieser bestimmten Datei erwähnt. Eg. Es sollte alle 12 Dateien öffnen und dann in der ersten Datei namens Cash Report wie am 11-05-2017, in der letzten Zeile der Spalte A dieser Datei - sollte der Name dieser bestimmten Datei erwähnt werden.

Also, wenn die VBA Datei "Cash Report wie am 11-05-2017 0400Hrs" geöffnet, dann in der letzten Zelle der Spalte A direkt nach dem Text oder Daten in der Zelle, mit Offset die sehr unter leere Zelle haben sollte der Name dieser Datei als "Cash Report wie am 11-05-2017 0000Hrs". Genauso brauchen Sie so etwas für alle Dateien, die jede einzelne Datei öffnen und den entsprechenden Dateinamen in der letzten Zeile der Spalte A aktualisieren.

Ich habe versucht, einige der Codes, aber es ist immer noch in Bits und Stücken. Versuchen

Dim Source As String 
    Dim StrFile As String 

    'do not forget the last backslash in the source directory. 
    Source = "C:\Users\Admin\Desktop\VBA\" 
    StrFile = Dir(Source) 

    Do While Len(StrFile) > 0 
     Workbooks.Open Filename:=Source & StrFile 
     StrFile = Dir() 
    Loop 

    fldr = Activeworkbook.Path 
Dt = Application.InputBox("Enter Date as 'dd-mm-yyyy' ", format(Now," dd-mm-yyyy" 
Workbooks.open Filename:= fldr & "\Cash Report as on" & 0400 & "Hrs.xlsx" 
Range("A1").End(xlDown).Select 
Offset(1).Select 

Answer 1

Diese

Sub t() 
    Dim Source As String 
    Dim StrFile As String 
    Dim wb As Workbook 

    'do not forget last backslash in source directory. 
    Source = "C:\Users\Admin\Desktop\VBA\" 
    StrFile = Dir(Source) 

    Do While Len(StrFile) > 0 
     Set wb = Workbooks.Open(Source & StrFile) 
     wb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = wb.Name 
     StrFile = Dir() 
     wb.Close (True) 
    Loop 

End Sub 

Answer 2

so etwas wie dies versuchen.

Annahmen:

• Der Name Excel-Datei immer in dem ersten Blatt eingefügt werden wird - falls die spezifischen Blätter Benennung Jeder Zeile in der Tabelle immer in der gleichen Art und Weise Sheets(1) mit Sheets("YourName")
• Linien Wechsel von Spalte A in Blätter (1) nicht leer ist, wie ich bin mit COUNTA Funktion (thx @Darren Bartrup-Koch)

Code:

Sub InsertFileName() 

Dim strFolderPath As String 
Dim lngLastRow As Long 
Dim FileName As String 
Dim WorkBk As Workbook 
Dim ErrNumbers As Integer 

'Choose folder with Excel files 
strFolderPath = GetFolder(ThisWorkbook.Path) & "\" 

'Loop through all Excel files in FolderPath 
FileName = Dir(strFolderPath & "*.xl*") 
Do While FileName <> "" 

    'Open Excel file 
    Set WorkBk = Workbooks.Open(strFolderPath & FileName) 

    'Find the last row in A column 
    On Error Resume Next 
    lngLastRow = Application.WorksheetFunction.CountA(WorkBk.Sheets(1).Range("A:A")) + 1 
    If lngLastRow = 1 Then 
     ErrNumbers = ErrNumbers + 1 
     Err.Clear 
     GoTo NextWkb 
    End If 

    WorkBk.Sheets(1).Range("A" & lngLastRow).Value = WorkBk.Name 
NextWkb: 
     'Close file and save changes 
     WorkBk.Close True 
     'Next file 
     FileName = Dir() 
    Loop 

If ErrNumbers <> 0 Then 
    MsgBox "There were some problems with Excel files. Check if there is some empty sheet or empty A column in one or more Excel files and try again" 
Else 
    MsgBox "Everything went fine!" 
End If 


End Sub 


Function GetFolder(strPath As String) As String 
Dim fldr As FileDialog 
Dim sItem As String 
Set fldr = Application.FileDialog(msoFileDialogFolderPicker) 
With fldr 
    .Title = "Select a Folder" 
    .AllowMultiSelect = False 
    .InitialFileName = strPath 
    If .Show <> -1 Then GoTo NextCode 
    sItem = .SelectedItems(1) 
End With 
NextCode: 
GetFolder = sItem 
Set fldr = Nothing 
End Function