Excel自己进行文件覆盖

我正在为下面的algorithm写一个Excelmacros：

脚步：

1）通过Outlook中的电子邮件循环

2）下载附件（excel文件）到一个特定的文件夹

3）打开Excel仪表板模板

4）打开保存的附件（excel文件）

5）将数据从附件复制到模板

6）closures附件

7）调整模板中的数据

8）保存模板作为新的工作簿

9）转到步骤3，继续下一个附件

我的问题是，在步骤6中，文件（附件）并没有完全closures – 它仍然可以在项目浏览器中看到，所以每当我将模板excel保存为新的Dashboard.xlsx时，它立即用附件覆盖它。 我已经search的解决scheme，但我发现是使用附件workbooks.close ，这不适合我。

我发现完全closures附件的唯一方法是closures模板文件，所以看起来好像是以某种方式连接的。

这里是代码：

 ' 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 

Answer 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") 

这将创build一个新的模板而不是仅仅打开模板文件。

编辑：！！

另外考虑

 Application.Workbooks.Open "../attachment.xlsx" '<- I have shorten the path for the purpose of posting Set att_book = ActiveWorkbook 

– >

 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