使用新输入将单个Excel工作表另存为新的Excel文件

时间:2014-04-27 21:28:28

标签: excel vba ms-access

我正在使用vba并访问2010.我这里有一个excel文件作为模板,有3个不同的工作表,我想在这些不同的工作表中写东西取决于我的访问数据库中的内容。我只有一个麻烦:不应该更改原始的Excel模板文件。我想总是保存在我的输入的新文件中,这次只有1个工作表(取决于访问数据库中的什么)。

所以这是我的访问代码:

Dim excelObject As Object
Dim sheet As Object
Dim myRec As DAO.Recordset
Dim fldCustName As DAO.Field

'open excel file
Set objExcel = CreateObject("Excel.Application")
Set excelObject = objExcel.Workbooks.Open("MyTemplate.xlsx")
Set sheet = excelObject.Worksheets(1)

'read table
Set myRec = CurrentDb.OpenRecordset("MyTable")
Set fldCustName = myRec.Fields("ID")

'select worksheet and add text to excel depends on table
If fldCustName = 1000 Then
    sheet.Cells(1, "A") = "Loop..."
End If
If fldCustName = 2000 Then
    sheet.Cells(1, "A") = "Loop..."
End If
'and so on...

'save and close
excelObject.Save 'problem: writes always in the same file and only worksheet 1
excelObject.Close
objExcel.Quit 

正如我所说,问题是我总是在template.xlsx中保存更改,而且我也忽略了其他工作表。解决这个问题的最简单方法是什么?也许:

reading the table -> decide which worksheet I need -> save this worksheet as .xlsx -> start writing

但是怎么样?有任何想法吗?谢谢

1 个答案:

答案 0 :(得分:2)

下面的代码将您的工作簿保存在一个新位置,其中只有一个工作表包含您的输出。

Excel.Application.DisplayAlerts=False 'suppresses dialog boxes when deleting worksheets
Dim wsName As String

'replace this code with a function that gives you the name of the worksheet
wsName = "1"

'add your code to query the data and write to worksheet here

For Each Sh In excelObject.Worksheets
    If Sh.Name <> wsName Then
        Sh.Delete
    End If
Next Sh

ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & wsName & "output.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Excel.Application.DisplayAlerts=True
excelObject.Close