I am trying to create worksheets depending on the number of files present in the current folder.This is my current folder:
Folder
CalculationSheet.xls
Data1.xls
Data2.xls
Data3.xls
So I'll be searching for "/*.xls" using the count.
I need to create worksheets in CalculationSheet.xls as I am new to macro. Please help me on this.
Use a code something like this:
Sub GetDataFiles()
Dim strFolder As String
Dim fso As Object
Dim fileTemp As Object
Dim ws As Worksheet
' Open library of Microsoft Scripting Runtime
Set fso = CreateObject("Scripting.FileSystemObject")
strFolder = ActiveWorkbook.Path
If (fso.FolderExists(strFolder)) Then
' Check All files in the folder
For Each fileTemp In fso.GetFolder(strFolder).Files
If fileTemp.Name Like "Data*.xls" Then
Set ws = ActiveWorkbook.Sheets.Add
ws.Name = fileTemp.Name
End If
Next
End If
End Sub
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 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.
I have created this piece of code, and I don't understand why I get an error
Subscript out of range
It dies when I try to set WsDest.
The two lines before I need, cause the destination file is optional, but the name of the sheet Excel file and sheet is always the same.
An example of what could be in W12 = "C:\Users\DKOMGOMG\Desktop\Etellerandet"
Sub Vopy_Paste_Below_Last_Cell()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim 1CopyLastRow As Long
Dim 1DestLastRow As Long
Dim strFolder As string, strFile As String
Set wsCopy = Activewoork.Worksheets("output")
StrFolder = ActiveSheet.Range("W12").Value
StrFile = Dir(StrFolder & "\blablalba.xlsm")
Set wsDest = Workbooks("strFile").Worksheets("Ark2")
After this I have more code of course, but this is where I get stranded.
Don't know if I did the strfolder and strfile wrong? Hope someone can help!
I am trying to make a macro that opens all .xlsm files in a folder:
C:\Users\iborrego\Desktop\zfichasmacro\Fichas excel\
And copy some cells (from different worksheets).
Information from each file should be assigned only to one row as I will use the first row for titles (ID Nº; Date of visit etc …)
And one row for each file in the folder.
I would really appreciate if you could help me write the macro and tell me how it works as I am not an IT.
I did not understand the second part of your question, but here is a code which opens every xlsm in your given folder:
Sub Xlsmopener()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\iborrego\Desktop\zfichasmacro\Fichas excel")
i = 1
For Each objFile In objFolder.Files
If objFSO.GetExtensionName(objFile.Path) = "xlsm" Then
Workbooks.Open (objFile.Path)
End If
i = i + 1
Next objFile
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)