Vba Excel浏览文件夹并自动将数据输入默认模板
我一直在阅读网络上各种来源的代码,并通过自学编程进行调试,以使其正常工作,但我很难继续下去 正如你所看到的,它来自一个源头。浏览文件夹和读取文件与代码配合良好,我需要复制此文件夹中的值,并将其粘贴到代码中指定的默认模板中,并使用默认格式保存文件,并与代码中指定的单元格(O1)和(O11)中的值一起保存 如您所见,不会保存为xlsx,也不会使用指定单元格中的值进行保存 接下来,自动将数据输入到指定字段。只有前3个文件能够完全复制我想要的内容。其余的输入错误的数据,如下图所示。此外,我还需要将从文件夹中的文件读取的单元格N15:O83中的值复制到模板列AA和AB中,分别从第6行开始 提前感谢您提供的任何帮助 样本源文件 正确的自动化 自动化错误 宏代码Vba Excel浏览文件夹并自动将数据输入默认模板,vba,excel,Vba,Excel,我一直在阅读网络上各种来源的代码,并通过自学编程进行调试,以使其正常工作,但我很难继续下去 正如你所看到的,它来自一个源头。浏览文件夹和读取文件与代码配合良好,我需要复制此文件夹中的值,并将其粘贴到代码中指定的默认模板中,并使用默认格式保存文件,并与代码中指定的单元格(O1)和(O11)中的值一起保存 如您所见,不会保存为xlsx,也不会使用指定单元格中的值进行保存 接下来,自动将数据输入到指定字段。只有前3个文件能够完全复制我想要的内容。其余的输入错误的数据,如下图所示。此外,我还需要将从文
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
Sub-LoopAllExcelFilesInFolder()
'用途:循环浏览用户指定文件夹中的所有Excel文件并对其执行设置任务
来源:www.TheSpreadsheetGuru.com
将wb设置为工作簿
将myPath设置为字符串
将myFile设置为字符串
Dim myExtension作为字符串
Dim FldrPicker As FILE对话框
以线的形式插入
将日期改为日期
将InstBR变暗为字符串
'优化宏速度
Application.ScreenUpdating=False
Application.EnableEvents=False
Application.Calculation=xlCalculationManual
'从用户检索目标文件夹路径
Set FldrPicker=Application.FileDialog(msoFileDialogFolderPicker)
用FldrPicker
.Title=“选择目标文件夹”
.AllowMultiSelect=False
如果.Show-1,则转到下一个代码
myPath=.SelectedItems(1)和“\”
以
"如果取消,
下一个代码:
myPath=myPath
如果myPath=”“,则转到重置设置
'目标文件扩展名(必须包含通配符“*”)
myExtension=“*.xls*”
'具有结束扩展名的目标路径
myFile=Dir(myPath&myExtension)
'循环浏览文件夹中的每个Excel文件
当我的文件“”时执行此操作
'将变量设置为等于打开的工作簿
设置wb=Workbooks.Open(文件名:=myPath&myFile)
'在继续下一行代码之前,确保工作簿已打开
多芬特
'在这里输入代码
机构=范围(“O1”)
InstDate=范围(“O11”)
InstBR=“基本读数”
wb.工作表(1).范围(“B15:E83”).副本
工作簿.添加模板:=“C:\Users\PC1\Desktop\Daily data file\Inc\TestTemplate.xlsx”
工作表(ActiveSheet.Index+1)。激活
如果错误编号为0,则为工作表(1)。激活
范围(“M6”)。选择
Selection.Paste特殊粘贴:=xlPasteValues,操作:=xlNone,SkipBlank_
:=假,转置:=假
范围(“E6:F76”)=Institd
范围(“K6:K76”)=安装日期
范围(“J6”)=InstBR
ChDir(“C:\Users\PC\Desktop\Daily data file\Inc\INC22001-Copy\Test Save”)“将文件另存为xlsm所需的目录
文件名=(“测试数据”)和范围(“O1”).Value&“;”和范围(“O11”).Value
ActiveWorkbook.SaveAs文件名:=文件名,文件格式:=xlOpenXMLWorkbook
'保存并关闭工作簿
wb.Close SaveChanges:=真
'在继续下一行代码之前,确保工作簿已关闭
多芬特
'获取下一个文件名
myFile=Dir
环
'任务完成时的消息框
MsgBox“任务完成!”
重置设置:
'重置宏优化设置
Application.EnableEvents=True
Application.Calculation=xlCalculationAutomatic
Application.ScreenUpdating=True
端接头
这看起来有问题
Filename = ("Test_Data_ ") & Range("O1").Value & ";" & Range("O11").Value
ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbook
您需要添加
& ".xlsx"
要正确形成工作簿文件名,请将文件扩展到顶行末尾。根据前面的回答,您需要为文件提供扩展名。但是,您也在柔和地引用范围O1和O11(这意味着您没有指定工作表)。如果这些值需要来自您正在打开的文件,我将使用
wb.Worksheets(1).Range(“O1”).Value
显式引用它们。从外观上看,您无意中从目标表中获取了这些值(请参见屏幕截图2中的单元格O11和屏幕截图1中的第四个文件)
对于在文件名中输入原始日期,我也会非常谨慎。您最好有一个邮戳:
Filename=“Test_Data_uquo&instd&“;”Format(InstDate,“YYYYMMDD”)&.xlsx“
您好,如果我错了,请纠正我。好吧,根据你的解释,我明白了
首先您有一个模板(wbTemplate),然后是一组其他工作簿,您需要根据给定的模板打开并预格式化它,然后将其保存在目标路径上
您需要练习动态设置所有对象
我在每一行上都添加了注释,这样您就可以理解这是如何工作的
{
Sub-LoopAllExcelFilesInFolder()
'用途:循环浏览用户指定文件夹中的所有Excel文件并对其执行设置任务
来源:www.TheSpreadsheetGuru.com
将wbTemplate作为工作簿,wbSourceFile作为工作簿
Dim wsTemplate作为工作表,wsSourceFile作为工作表
将SourceFileEndRow变长,TemplateEndRow变长
Dim myPath As String,myFile As String'这是源文件所在的位置
Dim myExtension作为字符串
Dim FldrPicker As FILE对话框
以线的形式插入
将日期改为日期
将InstBR变暗为字符串
Dim targetPath As String“将其设置为要保存所有输出文件的位置
设置wbTemplate=ThisWorkbook
设置wsTemplate=ThisWorkbook.Sheets(1)'输入模板的索引号,或者更好地根据模板选项卡的名称重命名模板
targetPath=“C:\Users\Enrerol\Desktop\Tester\targetPath\”设置要保存输出文件的位置
'优化宏速度
Application.ScreenUpdating=False
Application.EnableEvents=False
Application.Calculation=xlCalculationMa
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