使用VBA的Excel文件单元格内文件的名称

Question

我需要一个VBA，它在那个特定的“excel文件”内更新“excel文件的名称”。该文件夹中有12个文件。此文件夹的路径是D：\ Amit。这12个文件的名称是“从午夜开始的现金报告”（这就是为什么0000Hrs），并且它增加了2个小时使它成为0200Hrs，0400Hrs等。我们每2小时后每天准备这些文件。有时候确实发生了，我们在3小时后运行该文件，使其在0500Hrs之后运行，而不是0200Hrs之后的0400Hrs。我需要的是一个VBA文件，它可以打开所有这12个文件，并在每个文件最后一行的A列中提到该特定文件的名称。例如，它应该打开所有12个文件，然后在名为Cash Report的第一个文件中显示为11-05-2017，在此文件的A列的最后一行中 - 应该提及此特定文件的名称。

因此，如果VBA打开文件“Cash Report as on 11-05-2017 0400Hrs”，那么在列A的最后一个单元格紧跟着单元格中的文本或数据之后，使用偏移量非常小的空白单元格应该有该文件的名称为“11-05-2017 0000Hrs的现金报告”。同样，需要这样的所有文件，打开每个单独的文件，并更新列A的最后一行内的相应文件名。

我正在尝试一些代码，但它仍然是零散的。

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

尝试这个

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

尝试这样的事情。

假设：

• Excel文件名称将在第一页总是粘贴 - 的情况下，具体的床单总是以同样的方式改变线与Sheets("YourName")
• 每一行从命名Sheets(1)表在表（1）A列不为空，因为我使用COUNTA函数（THX @Darren Bartrup库克）

代码：

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