I am working on a VSTO Excel add-in where at some point, it will open a template workbook from Resources and copy a sheet from it to the running instance of Excel. I want to avoid the short white window flash when copying from the template so I created a hidden instance of Excel.Application and call it from there. This part works but when copying, I keep getting "System.Runtime.InteropServices.COMException: 'Copy method of Worksheet class failed'"
Dim tempFileName As String = "DesignWorks1_Template"
Dim tempName As String = Path.GetTempPath() & "\" & tempFileName & ".xlsx"
Dim ResMgr = New Resources.ResourceManager("MyUtilities.Resources", System.Reflection.Assembly.GetExecutingAssembly)
Dim fstream As New FileStream(tempName, FileMode.Create, FileAccess.Write)
Dim filestreamWrite As New BinaryWriter(fstream)
filestreamWrite.Write(My.Resources.DesignWorks1, 0, My.Resources.DesignWorks1.Length)
fstream.Close()
filestreamWrite.Close()
Dim currentWorkbook As Excel.Workbook = Globals.ThisAddIn.Application.ActiveWorkbook
Dim newHiddenApp As New Excel.Application
newHiddenApp.Visible = False
Dim oTemplate As Excel.Workbook = newHiddenApp.Workbooks.Add(tempName)
oTemplate.Worksheets(compareName).Copy(currentWorkbook.Worksheets(1)) 'error here
oTemplate.Close()
My.Computer.FileSystem.DeleteFile(tempName)
ResMgr.ReleaseAllResources()
Thanks in advance.
Is it possible to specify a particular sheet from the template? I tried Sheets.Add but it seems to import all worksheets from the specified path. – Virtual Underscore
This is the major pain point in exporting each sheet in a workbook to a WorkSheet template file. When you perform the save-as Worksheet template, the subject Worksheet must be the only Worksheet in the Workbook. If more than one Worksheet exists in the Workbook, you will be exporting a Workbook template.
You can copy the following VBA code to the ThisWorkbook code file of the Workbook you want to export templates from. Make sure you modify the templateFolder = "F:\Temp\Templates" line in the code. Run it and it will export each Worksheet in the Workbook.
Sub ExportWorksheetTemplates()
Excel.Application.DisplayAlerts = False
Excel.Application.ScreenUpdating = False
Dim templateFolder As String
templateFolder = "F:\Temp\Templates" ' set this to an existing folder on you system
Dim tmpWb As Excel.Workbook
Dim old_numsheets As Integer
old_numsheets = Excel.Application.SheetsInNewWorkbook
Excel.Application.SheetsInNewWorkbook = 1
Dim ws As Excel.Worksheet
Dim newWBFirstSheet As Excel.Worksheet
Dim templatePath As String
On Error GoTo Finalize
For Each ws In ThisWorkbook.Worksheets
Set tmpWb = Excel.Application.Workbooks.Add()
Set newWBFirstSheet = tmpWb.Worksheets(1)
newWBFirstSheet.Name = "."
ws.Copy after:=newWBFirstSheet
newWBFirstSheet.Delete
templatePath = templateFolder & "\" & tmpWb.Worksheets(1).Name & ".xltx"
tmpWb.Worksheets(1).SaveAs templatePath, Excel.XlFileFormat.xlOpenXMLTemplate
tmpWb.Close
Next
Finalize:
Excel.Application.DisplayAlerts = True
Excel.Application.ScreenUpdating = True
Excel.Application.SheetsInNewWorkbook = old_numsheets
End Sub
Now you can add each of those files to your VSTO project's resources.
Then you would export the resource templates to a temporary file as you are currently doing.
When you use the Sheets.Add method and specify Type:="path to template", you will now only get the single Worksheet added to the Workbook.
When running Excel on the desktop, you cannot copy sheets between instances. Therefore I doubt that it can be done when the Excel instances are initiated with VB.
In order to copy sheets between workbooks, these need to run in the same instance.
Related
I want to update a read-only workbook from the file "Data.xlsx".
I change the file in another application in a read-write workbook.
When I try to close the read-only workbook after updating it, an error accours.
This is my code:
Option Explicit
Public xlApp As New Application
Public wb_readWrite As Workbook
Public wb_readOnly As Workbook
Sub main()
Dim path As String
path = ThisWorkbook.path & "\Data.xlsx"
Set wb_readOnly = Workbooks.Open(path, readOnly:=True)
Set wb_readWrite = xlApp.Workbooks.Open(path, readOnly:=False)
wb_readWrite.Sheets(1).Cells(1, 1) = InputBox("Input your data")
wb_readWrite.Save
MsgBox "Update Now"
wb_readOnly.UpdateFromFile
wb_readWrite.Close
wb_readOnly.Close 'Error is here
Set wb_readWrite = Nothing
Set wb_readOnly = Nothing
End Sub
Looks like calling UpdateFromFile reloads the workbook and breaks any existing VBA references to the workbook - you need to re-establish any references after the update.
So you could use a wrapper like this for example:
Sub ReloadWorkbook(wb As Workbook)
Dim app As Application, nm As String
Set app = wb.Application 'in case in a different instance of Excel
nm = wb.Name
wb.UpdateFromFile
Set wb = app.Workbooks(nm)
End Sub
and call
ReloadWorkbook wb_readOnly
instead of wb_readOnly.UpdateFromFile
I import sheets into a file, then save the file with a new name in a different location.
The macro works until the memory usage for Excel reaches about 3,000MB, at which point an "Out of Memory" error occurs. (There is 32GB of memory on this PC.)
The error occurs on this line, Set Wkb3 = Workbooks.Open(filename:=Path & "\" & filename) presumably because there isn't enough memory to open another file.
Wkb3, which is the source file where the sheet is being imported from, is closed after the import.
Wkb2, which contains the collection of imported sheets is saved and closed after the imports are done.
Wkb1 is the only one that is constantly open.
I usually manage to go through 40 or so iterations before the crash, so clearly even though all Wkb2 and Wkb3 are being closed, something is staying in Excel's memory.
I tried saving Wkb2 after each import to see if that will release memory.
I tried setting Objects to nothing.
Here's my macro:
Option Explicit
Sub CombineFiles()
Call NewBook 'this marco creates a new file that will hold the imported sheets
Dim Wkb1 As Workbook 'Wkb with Macro
Set Wkb1 = ThisWorkbook
Dim Aname As String
Aname = Wkb1.Sheets(1).Range("A1").Value & "\Master File\Master File.xlsx" 'cell A1 holds the path for each individual folder that holds files that need to be combined
Dim Wkb2 As Workbook 'MasterBook
Set Wkb2 = Workbooks.Open(filename:=Aname)
Dim Wkb3 As Workbook 'DataSource
Dim ws1 As Worksheet 'Wkb with Macro
Set ws1 = Wkb1.Worksheets(1)
Dim ws3 As Worksheet 'DataSource
Dim MyOldName As String
MyOldName = Wkb2.FullName
Dim Path As String
Path = ws1.Range("A1").Value
Dim filename As String
filename = Dir(Path & "\*.xlsx", vbNormal)
Dim Path2 As String
Dim filename2 As String
Path2 = Path & "\Master File\"
Do Until filename = ""
Set Wkb3 = Workbooks.Open(filename:=Path & "\" & filename)
For Each ws3 In Wkb3.Worksheets
ws3.Copy after:=Wkb2.Sheets(Wkb2.Sheets.Count)
Next ws3
Wkb3.Close False
filename = Dir()
Loop
Application.DisplayAlerts = False
filename2 = Wkb2.Worksheets(2).Range("A2").Text
Wkb2.SaveAs filename:=Path & filename & ".xlsx"
Wkb2.Close True
Kill MyOldName
Call KillFiles
Application.DisplayAlerts = True
End Sub
Unfortunately, the only fix I was able to come up with was to Kill excel and restart the Macro via the Windows Task Scheduler. It doesn't fix the "out of memory" error, but at least it restarts the Macro every now and then so I don't lose time on it being stuck on this error.
If you are running Exce32 bits, the limit is 4Gb.
I have some code for exporting subform results to Excel workbook. Code works fine, only one small issue. If I do export, excel file opens If user wants I open. When this Excel file is opened and user wants to do Export again, I receive error 1004.
This error is produced because file is open, and new Excel object want to save a file with same name. What I want is when this happens, just cancel everything and let user know that he must first close this previously created workbook. Here is what I tried:
If Err.Number = 1004 Then
MsgBox "Error. You have opened Excel file, that has same name as this file name should be. Please close that file first !", vbCritical
Cancel = True
Set wb = Nothing ' wb is wb=XcelFile.Workbooks.Add
Set XcelFile = Nothing ' Xcelfile is Xcelfile= New Excel.Application
End If
This code works, when user closes that file, export can be performed - old file is just overwritted. Problem is that Excel application is still opened in Windows Task Manager, so Excel object is not properly closed.
Does anybody have a better solution ?
P.S.: I tried including numbers in file name of Excel, so that It wouldn't be same name, but I can't get It fixed.
EDIT: Here is how I tried changing filename
Dim i as Integer
ExcelFilename = "RESULTS_" & Format(Date, "dd/mm/yyyy") & "_" & i & "_" & ".xlsx"
i = i + 1
"i" doesn't change It's value when I run code once again. How can I make it increment ? This would solve my problem...
I suggest a simple solution: add the time to the file name to prevent conflicts.
ExcelFilename = "RESULTS_" & Format(Now(), "yyyy-mm-dd_hh-nn-ss") & ".xlsx"
For a number that will increment as long as the application is running, try
Static i As Integer
Static variables
You must be very strict in opening the Excel objects and closing them in reverse order - as done in this example:
Public Sub RenameWorkSheet()
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("c:\test\workbook1.xlsx")
Set wks = wkb.Worksheets(1)
wks.Name = "My New Name"
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Sub
I have an Excel source workbook and I have some people that sent me other workbooks with information so I can add this info to the source workbook.
I want to know if it's possible to import these workbooks into the Source Workbook so that my records automatically update and the records that are new be added to the Source Workbook
Using this code you get all the files in the folder. which in your case would be the additional workbooks added.
Dim MyObject As Scripting.FileSystemObject
Set MyObject = New Scripting.FileSystemObject
Dim mySource As Folder
Dim myFile As Scripting.File
dim strFolder as string
strFolder = 'you folder path
dim strFilePath as string
Set mySource = MyObject.GetFolder(strFolder)
For Each myFile In mySource.Files
strFilePath = myFile.Path
Next
Once you have file paths you use this code to open to the workbooks
dim wrkBook as workbook
set wrkbook = workbooks.open(strFilePath)
Once you've opened the workbooks the rest is pretty much straight forward
youVariable = wrkbook.worksheet(1).cells(i, j)
I understand how to save a worksheet as a new workbook, but how do I can specify the name dynamically?
I've tried both Save As and Save as filename but I can't figure out how to put a variable into the name successfully.
Sub sheetCopy()
Dim wbS As Workbook, wbT As Workbook
Dim wsS As Worksheet, wsT As Worksheet
Dim title As String
title = ThisWorkbook.Worksheets("IR General Info").Range("B2").Text
Set wbS = ThisWorkbook 'workbook that holds this code
Set wsS = wbS.Worksheets("Bulk Upload")
wsS.Copy
Set wbT = ActiveWorkbook 'assign reference asap
Set wsT = wbT.Worksheets("Bulk Upload")
wsT.Name = "Exported_BulkUpload" 'rename sheet
wbT.SaveAs wbS.Path & "\" & title & ".xlsx"
End Sub
So If I make title something like "boo" with quotes - this code works. But how do I make it change based on the variable title?
Have you tried assigning the title variable to Range("B2").Value instead of Range("B2").Text ?
If the files are in the same folder, you might be able to use wbT.SaveAs FileName:=title instead
Try this:
Sub sheetCopy()
Dim wbS As Workbook, wbT As Workbook
Dim wsS As Worksheet, wsT As Worksheet
Dim title As String
title = ThisWorkbook.Worksheets("IR General Info").Range("B2").Text
'<<step through the macro and once you have gone past this point do Ctl+G to get the immediate window then type ?title in it and press enter. Or just hover your mouse over title in this script - has a value been assigned to it?
'<<the following line is not required - ThisWorkbook object is sufficient:
'Set wbS = ThisWorkbook 'workbook that holds this code
Set wsS = ThisWorkbook.Worksheets("Bulk Upload")
wsS.Copy '<<I've changed below here so it is saved straight away
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & title & ".xlsx"
Set wbT = excel.workbooks(title & ".xlsx") 'assign reference
Set wsT = wbT.Worksheets("Bulk Upload")
wsT.Name = "Exported_BulkUpload" 'rename sheet
End Sub