Question

我一直在阅读网上各种来源的代码，并通过自学编程进行调试以使其正常工作，但我仍然难以继续。

如您所见，它来自一个来源。浏览文件夹＆amp;阅读文件与代码工作正常，我需要复制此文件夹中的值＆amp;将其粘贴到代码＆amp;中指定的默认模板中使用默认格式保存文件，并沿着单元格（O1）和＆amp; （O11）在代码中分配。

如您所见，未保存为xlsx，也未使用指定单元格中的值进行保存。

接下来，自动将数据输入到指定的字段。只有前3个文件能够准确复制我想要的内容。其余的输入错误的数据，如下图所示。另外，我还需要将单元格N15：O83中的值从文件夹中的文件复制到模板列AA＆amp; AB分别从第6行开始。

提前感谢您提供的任何帮助。

示例源文件 正确的自动化 错误的自动化

宏代码

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and             perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim InstID As String
Dim InstDate As Date
Dim InstBR As String




'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
  .Title = "Select A Target Folder"
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

    'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

  'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
'Set variable equal to opened workbook
  Set wb = Workbooks.Open(Filename:=myPath & myFile)

'Ensure Workbook has opened before moving on to next line of code
  DoEvents

'Input Code Here

  InstID = Range("O1")
  InstDate = Range("O11")
  InstBR = "Base Reading"

  wb.Worksheets(1).Range("B15:E83").Copy
  Workbooks.Add template:="C:\Users\PC1\Desktop\Daily data file\Inc\TestTemplate.xlsx"
  Sheets(ActiveSheet.Index + 1).Activate
  If Err.Number <> 0 Then Sheets(1).Activate
  Range("M6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Range("E6:F76") = InstID
    Range("K6:K76") = InstDate
    Range("J6") = InstBR

ChDir ("C:\Users\PC\Desktop\Daily data file\Inc\INC22001 - Copy\Test Save") ' Directory you need to save the file as xlsm
Filename = ("Test_Data_ ") & Range("O1").Value & ";" &     Range("O11").Value
ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbook

'Save and Close Workbook
  wb.Close SaveChanges:=True

'Ensure Workbook has closed before moving on to next line of code
  DoEvents

'Get next file name
  myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Answer 1

这看起来有问题

Filename = ("Test_Data_ ") & Range("O1").Value & ";" &     Range("O11").Value
ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbook

你需要添加

& ".xlsx"

到顶行的末尾以正确形成工作簿文件名。

Answer 2

根据上一个答案，您需要为文件提供扩展名。而且，您正在轻柔地引用您的Ranges O1和O11（意味着您没有指定工作表）。如果这些值需要来自您打开的文件，我会使用wb.Worksheets(1).Range("O1").Value明确引用它们。从它的外观来看，你无意中从目标表中获取了这些值（见屏幕截图2中的单元格O11和屏幕截图1中的第四个文件）。

我也非常谨慎地将原始日期放在文件名中。使用日期戳时，您会更好：Filename = "Test_Data_ " & InstID & ";" & Format(InstDate,"YYYYMMDD") & ".xlsx"

Answer 3

嗨如果我错了请纠正我。好的，这是我根据你的解释理解的事情。

首先，您有一个模板（wbTemplate），然后是一组其他工作簿，您需要根据给定的模板打开并预先格式化它，然后将其保存在目标路径上。

您需要练习动态设置所有对象。

我在每一行都写了评论，这样你就可以理解它是如何工作的了。

{

 Sub LoopAllExcelFilesInFolder()
 'PURPOSE: To loop through all Excel files in a user specified folder and             perform a set task on them
 'SOURCE: www.TheSpreadsheetGuru.com

 Dim wbTemplate As Workbook, wbSourceFile As Workbook
 Dim wsTemplate As Worksheet, wsSourceFile As Worksheet
 Dim SourceFileEndRow As Long, TemplateEndRow As Long
 Dim myPath As String, myFile As String 'This is where the Source File      located
 Dim myExtension As String
 Dim FldrPicker As FileDialog
 Dim InstID As String
 Dim InstDate As Date
 Dim InstBR As String
 Dim targetPath As String 'Set this to where you want to save all the output files

 Set wbTemplate = ThisWorkbook
 Set wsTemplate = ThisWorkbook.Sheets(1) ' Input the Index no. of your      Template, or much better to rename it based on the Name of the Template Tab
 targetPath = "C:\Users\Enrerol\Desktop\Tester\TargetPath\" 'Set where you want to save your Output File
 'Optimize Macro Speed
   Application.ScreenUpdating = False
   Application.EnableEvents = False
   Application.Calculation = xlCalculationManual

 'Retrieve Target Folder Path From User
   Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

 With FldrPicker
   .Title = "Select A Target Folder"
   .AllowMultiSelect = False
     If .Show <> -1 Then GoTo NextCode
     myPath = .SelectedItems(1) & "\"
 End With

 'In Case of Cancel
 NextCode:
   myPath = myPath
   If myPath = "" Then GoTo ResetSettings

     'Target File Extension (must include wildcard "*")
   myExtension = "*.xls*"

   'Target Path with Ending Extention
   myFile = Dir(myPath & myExtension)

 'Loop through each Excel file in folder
   Do While myFile <> ""
 'Set variable equal to opened workbook
   Set wbSourceFile = Workbooks.Open(Filename:=myPath & myFile) ' Set our      SourceFile
   Set wsSourceFile = wbSourceFile.Worksheets(1) 'Set the Worksheet that we      are copying
 'Ensure Workbook has opened before moving on to next line of code
   DoEvents

 'Input Code Here

   InstID = wsSourceFile.Range("O1")
   InstDate = wsSourceFile.Range("O11")
   InstBR = "Base Reading"
 SourceFileEndRow = wsSourceFile.Range("B" & Rows.Count).End(xlUp).Row '      This to  make sure that you have a dynamic range; it will get the last row used      of the Source File
   wsSourceFile.Range("B15:E" & SourceFileEndRow).Copy      Destination:=wsTemplate.Range("M6")
 TemplateEndRow = wsTemplate.Range("M" & Rows.Count).End(xlUp).Row 'We will      get the last used row of our Destination Column
   wsTemplate.Range("E6:F" & TemplateEndRow) = InstID
   wsTemplate.Range("K6:K" & TemplateEndRow) = InstDate
   wsTemplate.Range("J6") = InstBR

 Filename = ("Test_Data_") & InstID & "_" & Format(InstDate, "m_d_yyyy") '      You need to change this, because there will be an error on your existing format.      Specially the instdate is Formated as "dd/mm/yyyy"
 Application.DisplayAlerts = False 'We will need to stop the prompting of      the excel application
 wbTemplate.SaveAs Filename:=targetPath & Filename,      FileFormat:=xlOpenXMLWorkbook
 Application.DisplayAlerts = True 'Reset application Values
 'Save and Close Workbook

 wbSourceFile.Close SaveChanges:=True
 wsTemplate.UsedRange.Delete
 'Ensure Workbook has closed before moving on to next line of code
   DoEvents

 'Get next file name
   myFile = Dir
   Loop

 'Message Box when tasks are completed
   MsgBox "Task Complete!"

 ResetSettings:
   'Reset Macro Optimization Settings
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

 End Sub

Excel浏览文件夹并将数据输入自动化为默认模板

3 个答案: