我正在为以下算法编写Excel宏:
步骤:
1)在Outlook中循环播放电子邮件
2)将附件(excel文件)下载到特定文件夹
3)打开Excel仪表板模板
4)打开已保存的附件(excel文件)
5)将数据从附件复制到模板
6)关闭附件
7)调整模板中的数据
8)将模板另存为新工作簿
9)转到第3步,继续下一个附件
我的问题是,在第6步中,文件(附件)没有完全关闭 - 它在Project Explorer中仍然可见,因此每次我将模板excel保存为新的Dashboard.xlsx时立即用附件覆盖它。我已经搜索了解决方案,但我发现只是在附件中使用workbooks.close
,这对我不起作用。
我发现完全关闭附件的唯一方法是关闭模板文件,所以看起来它们以某种方式连接。
以下是代码:
' this code gets called by a macro that downloads the attachments
Sub update_WB()
Dim main_book, att_book As Workbook
Dim lastrow, firstrow As Long
Dim att_name as string
Workbooks.Open "../template.xlsx" ‘<- I have shorten the path for the purpose of posting
Set main_book = Application.ActiveWorkbook
main_book.Worksheets("Raw Data").Activate
main_book.Worksheets("Raw Data").Cells.Select
Selection.ClearContents
Selection.UnMerge
Application.Workbooks.Open "../attachment.xlsx" ‘<- I have shorten the path for the purpose of posting
Set att_book = ActiveWorkbook
att_book.Worksheets(1).Range("A:BD").Select
Selection.Copy main_book.Worksheets("Raw Data").Range("A:BD")
att_book.Close ‘<- this is where the attachment should close, but it does not. It only disappears from windows taskbar.
main_book.Worksheets("Raw Data").Activate
lastrow = Worksheets("Raw Data").Cells(Worksheets("Raw Data").Rows.Count, "A").End(xlUp).Row - 1
For firstrow = 1 To 100
If Worksheets("Raw Data").Cells(firstrow, 1).Text = "Date" Then Exit For
Next firstrow
main_book.Worksheets("Raw Data").Activate
main_book.Worksheets("Raw Data").Cells.Select
Selection.UnMerge
main_book.Worksheets("Raw Data").Range("A" & firstrow & ":BG" & lastrow - 1).Name = "Raw_Data"
‘.
‘.
‘.
‘. Some data manipulation –> copy, paste, delete, etc.
‘.
‘.
‘.
‘.
Application.DisplayAlerts = False
main_book.SaveAs (“../Dashboard_" & Format(Timeserial(hour(now()),minute(now()),second(now())),"hhmmss") & ".xlsx") ‘<- I have shorten the path for the purpose of posting. This is where excel does the saving twice – first it saved the main_book and then att_book, both under the same name.
Application.DisplayAlerts = True
main_book.Close '<- this is where both of the files close entirely
End Sub
答案 0 :(得分:1)
您应该替换以下内容 -
Workbooks.Open "../template.xlsx" ‘<- I have shorten the path for the purpose of posting
Set main_book = Application.ActiveWorkbook
用
Set main_book = Workbooks.Add(Template:="../template.xlsx")
这会从模板中创建一个新的wb,而不仅仅是打开模板文件。
编辑:!!
还要考虑
Application.Workbooks.Open "../attachment.xlsx" ‘<- I have shorten the path for the purpose of posting
Set att_book = ActiveWorkbook
- &GT;
Set att_book = Application.Workbooks.Open "../attachment.xlsx"
这可以避免无意中推荐错误的打开的书籍。
编辑2:代码的工作部分,运行并保存没有错误
Sub update_WB()
Dim main_book, att_book As Workbook
Dim lastrow, firstrow As Long
Dim att_name As String
Set main_book = Workbooks.Add(Template:="template.xlsx") 'Corrected
main_book.Worksheets("Raw Data").Activate
main_book.Worksheets("Raw Data").Cells.Select
Selection.ClearContents
Selection.UnMerge
Set att_book = Application.Workbooks.Open("attachment.xlsx") 'Corrected
att_book.Worksheets(1).Range("A:BD").Select
Selection.Copy main_book.Worksheets("Raw Data").Range("A:BD")
att_book.Close
Set att_book = Nothing 'Added pointer reset, ultimately closes the workbook
main_book.Worksheets("Raw Data").Activate
lastrow = Worksheets("Raw Data").Cells(Worksheets("Raw Data").Rows.Count, "A").End(xlUp).Row - 1
For firstrow = 1 To 100
If Worksheets("Raw Data").Cells(firstrow, 1).Text = "Date" Then Exit For
Next firstrow
main_book.Worksheets("Raw Data").Activate
main_book.Worksheets("Raw Data").Cells.Select
Selection.UnMerge
'Application.DisplayAlerts = False
main_book.SaveAs ("Dashboard_" & Format(TimeSerial(Hour(Now()), Minute(Now()), Second(Now())), "hhmmss") & ".xlsx") ''<- I have shorten the path for the purpose of posting. This is where excel does the saving twice – first it saved the main_book and then att_book, both under the same name.
'Application.DisplayAlerts = True
main_book.Close
Set mainbook = Nothing 'Ultimately closes the template
End Sub