I have created one script which is launched on click button, so it loads CSV file from path and format and than save it. As I have files from 1...10000 so I made file like 1.txt and so on.
I am getting problem is when it start process everything goes fine but after 10-13 files it give error and excel closes. Following are codes I am using. Please assist me where I am doing mistake. I think I am doing mistake in array I tried redim but but that one gives me same error. This is sub which I placed on my button to start process. As I have more than thousands files so please suggest me solution.
Sub WorkbooksLoop()
' get the list of filenames
Dim pageStart As Integer
Dim pageEnd As Integer
pageStart = CInt(Cells(3, "C").Value) ' getting from cell of excel sheet
pageEnd = CInt(Cells(4, "C").Value) ' getting from cell of excel sheet
Dim Filenames(44) As String ' variable I know there are 44 files
For j = pageStart To pageEnd
Filenames(j) = CStr(j) + ".txt"
Next j
On Error GoTo NoFilenames
Dim controllerwb As Workbook
Set controllerwb = ActiveWorkbook
Dim wb As Workbook
Dim fname As Variant
Dim rootPath As String
rootPath = ThisWorkbook.Path
rootPath = rootPath & "\"
For Each fname In Filenames
' Make the controller active
controllerwb.Activate
On Error Resume Next
' If activate fails, then the workbook isn't open
Workbooks(fname).Activate
' If activate fails, then the workbook isn't open
If Err <> 0 Then
OpenFile (rootPath & fname)
Set wb = ActiveWorkbook
wb.Activate
' Otherwise, workbook is already open, refer to it by name
Else
OpenFile (rootPath & fname)
Set wb = ActiveWorkbook
End If
' do something to the open workbook my process to format sheet
deletingRowsColumns
ledgerSetup
resizeColumns
columnLines
columnAlignments
mergeTitles
settingNames
wb.Close
Next fname
NoFilenames:
End Sub
I have done everything and recode it in different way. But still after 10-20 files it through an error. As I was using windows machine on my mac as virtual machine, so I just thought why not i try it on mac with microsoft office. And have to change just forward slashes of directory to colon(interesting I thought it should be back slash but that is how vba was doing) and it worked I get alert of some file not saving, but it is ok at least I could do 1000 files easily rest I can save manually. But it realy work although vba engine is little bit slower in mac but who cares I just leave it for few hours to do all files for me.
Thanks for all your help. Mike yes I need to learn more about ActiveWorkbook and scripting. I will try to do as you told me but my work done. Thanks
Related
I'm building a macro that lets the user select a folder, select which tab to import, then it opens up every file in the folder, grabs all of the data in the given tab, and imports it into one main sheet for easy review.
It's breaking in an interesting way - when it's pasting the data in with the line
DestinationWorkbook.Sheets("Data").Range("A" & LastrowOutput).Resize(DataRng.Rows.Count, DataRng.Columns.Count).Value = DataRng.Value
It's posting in some of the data, then generating the error message "Run-time error '1004': Application-defined or object-defined error" For specifics, in my first file I have 15311 lines by DD columns. It imports 14832 lines as it generates the error message.
(Going to test with fewer columns)
Additionally, when debugging and stepping through, it jumps from the If statement directly to the problem while generating the problem and all of the data.
There is nothing unusual in the data at the lines given.
Am I hitting some technical limit? Does anyone know what's going on? My google-fu is failing me.
Edit: When running the code again with data in the tab, I manage to get to row 29663 before getting an "Automation error" error message. Still working on that column test...
Edit 2: Got it to only select the columns in question. Still breaks on the same row.
Edit 3: Broke up the code to do the first 10,000 rows, then all of the remaining rows. Still breaks on the same line. It was suggested that I look for hidden rows and columns - There are no hidden rows or columns. Going to try value2 and value3 next.
Sub PullingAllData()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim sPath As String
Dim sFil As String
Dim FolderPath As String
Dim diaFolder As FileDialog
Dim DestinationWorkbook As Workbook
Dim DataRng As Range
Dim LastrowInput As Double
Dim LastrowOutput As Double
'Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
FolderPath = diaFolder.SelectedItems(1)
' Cycle through spreadsheets in selected folder
Set DestinationWorkbook = ActiveWorkbook
Dim ImportTabNumber As Integer
ImportTabNumber = InputBox("Please Enter the tab to import.*", "Account Name")
sPath = FolderPath & "\" 'location of files
sFil = Dir(sPath & "*.xlsx") 'change or add formats
Do While sFil <> "" 'will start LOOP until all files in folder sPath have been looped through
Set owbk = Workbooks.Open(sPath & "\" & sFil) 'opens the file
If owbk.Sheets.Count >= ImportTabNumber Then
Set InputTab = owbk.Sheets(ImportTabNumber)
LastrowInput = InputTab.Range("A" & Rows.Count).End(xlUp).Row
Set DataRng = InputTab.Range("A1:DO" & LastrowInput).SpecialCells(xlCellTypeVisible)
LastrowOutput = DestinationWorkbook.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row + 1
DestinationWorkbook.Sheets("Data").Range("A" & LastrowOutput).Resize(DataRng.Rows.Count, DataRng.Columns.Count).Value = DataRng.Value
End If
owbk.Close True
sFil = Dir
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
This post (specifically the answer by Cees Timmerman near the bottom) may shed some light on the issue. It is also worth checking if you have a 32-bit or 64-bit version of Excel. If you have the former, you may be running out of memory.
If you have the latter, try creating a Variant array to store the data before transferring it (Dim MyData as Variant : MyData = MyRange.Value).
I would also recommend opening up your task manager and checking the performance tab. You should be able to use the resource monitor to track how much RAM is being used. RAM is very unlikely to be the source of the issue if you do have 64-bit, but it doesnt hurt to see what is happening behind the scenes (and how expensive that operation can be).
Before putting that code into production though I highly recommend more tests (with more files). If that code is already breaking, it will be very likely to break again in the future.
I have written this VBA code to save a new version of a file in a specified location. It works absolutely fine on my computer but won't work on a colleagues. We are both using the same version of Excel. I have made sure there are no passwords in the workbook and also made sure he has full permissions on the file.
Sub SaveNew()
Dim FileName As String
Dim Path As String
Dim Plnt As String
Dim PC As String
Dim fso As FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
'Save and calculate workbook before changes. Patse Filename so it doesnt change
ActiveWorkbook.Save
ActiveSheet.Calculate
ActiveSheet.Select
Range("c7").Copy
Range("c8").PasteSpecial xlPasteValues
'Define path and filename
Path = "Z:\UK\BFD\MAReports$\PPV & MR21\Stock Loss\Site Files\"
FileName = Sheets("Menu").Range("c8")
Plnt = Sheets("Menu").Range("c3")
PC = Sheets("Menu").Range("c5")
'Save new version
ThisWorkbook.SaveAs FileName:=Path & FileName & ".xlsm", FileFormat:=52
Any help appreciated!
There's a couple of things that are odd about this code, see comments to the right:
ActiveWorkbook.Save 'saves the current book (that's ok)
ActiveSheet.Calculate 'only meaningful if you have calculation set to manual
ActiveSheet.Select 'why select the activesheet, you're not using the selection
Range("c7").Copy 'why copy/paste c7 to c8? if c7 is empty the saveAs fails
Range("c8").PasteSpecial xlPasteValues 'this is better: Range("c8").Value = Range("c7").Value
And probably the problem you have is either caused by:
1- SaveAs does not save a copy but saves the current workbook under a new name so if another user on another computer runs the same macro and Z: is a shared drive then the other user/computer will have the same file locked that you want to save to until on the other computer Excel is closed and the other user/computer and you/your computer have the same privileges on this file.
2- You/your computer has no authorization to write on that network location
I've tested your code and I can replicate cause 1 with the same 1004 runtime error
I have code that should open open a handfull of workbooks, pull key info and close them. i can see the workbook loading but then when it is about to open i get the runtime error 1004 that says
Method 'open' of object 'workbooks' failed
My code is as follows and when i debug it takes me to the 2nd line under the do while statement:
Sub OEEsummmary()
Dim Gcell As Range
Dim MySheet As Worksheet
Dim Txt$, MyPath$, MyWB$
Dim myValue As Integer
Dim x As Long
Dim v As Variant, r As Range, rWhere As Range
MyPath = "L:\Manufacturing Engineering\Samuel Hatcher\"
x = 2
Set MySheet = ActiveSheet
Application.ScreenUpdating = False
Do While MySheet.Range("A" & x).Value <> ""
MyWB = MySheet.Range("A" & x).Text
Workbooks.Open Filename:=MyPath & MyWB, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
Set Gcell = ActiveSheet.Range("E21")
With MySheet.Range("A" & x)
.Offset(0, 7).Value = Gcell.Value
End With
ActiveWorkbook.Close savechanges:=False
x = x + 1
Loop
End Sub
I tried to change the different defined variable to variant as per instructions of other people who had the same issue but nothing worked. Any help is greatly appreciated thanks!
update* I moved the two file names that were an issue to the bottom of the list and every other file name opened and copied the info perfectly but when the loop got to the last two files it gives me that error. all of the files are manipulated copies of the bottom 2 so i dont see why it doesnt work
update2* it seems as though the only workbooks that give the error and wont load are the ones open on another computer in the network, when this program is run all the workbooks will be open on other computers
it turns out a few of the files were corrupted so when the code encountered this it didnt work. the solution to this problem was to close the corrupted workbook then when I reopened it I clicked the arrow next to open and selected "open and repair" then saved a new copy of the file and the code ran smoothly
I keep getting this 1004 runtime error. I have slimmed my programing down some so it’s not so Programception. I think it may have to do with using Excel 2010 to save .xls files. Not sure.
When Auto_Root.xls opens it runs Sub auto_open() which opens
Panel.xls
Panel opens and runs Sub Update() which sequentially opens 7 files
in different directories all called Auto_Update.xls
Auto_Update.xsl opens and runs Sub Flat which each open a number of
files sequentially and saves a flat copy of themselves in another
directory.
I have opened each of the 7 Auto_Update.xls files and have run them independently and they run with no errors. When I run them all from Auto_Root I get a runtime error 1004. And CurrentWB.Save is highlighted on one of the files. I even replaced CurrentWB.Save as CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=xlNormal and recieved the same runtime error.
Attached is the code I have.
AutoRoot.xls!Auto Update
Sub auto_open()
Application.CutCopyMode = False
Dim PanelFilePath As String
Dim PanelFileName As String
Dim PanelLocation As String
Dim PanelWB As Workbook
PanelFilePath = "D:\umc\UMC Production Files\Automation Files\"
PanelFileName = "Panel.xls"
PanelLocation = PanelFilePath & Dir$(PanelFilePath & PanelFileName)
Set PanelWB = Workbooks.Open(Filename:=PanelLocation, UpdateLinks:=3)
PanelWB.RunAutoMacros Which:=xlAutoOpen
Application.Run "Panel.xls!Update"
PanelWB.Close
Call Shell("D:\umc\UMC Production Files\Automation Files\Auto.bat", vbNormalFocus)
Application.Quit
End Sub
Panel.xls!Update
Sub Update()
Dim RowNumber As Long
Dim AutoUpdateTargetFile As String
Dim AutoUpdateWB As Workbook
For RowNumber = 1 To (Range("AutoUpdate.File").Rows.Count - 1)
If (Range("AutoUpdate.File").Rows(RowNumber) <> "") Then
AutoUpdateTargetFile = Range("Sys.Path") & Range("Client.Path").Rows(RowNumber) & Range("AutoUpdate.Path ").Rows(RowNumber) & Range("AutoUpdate.File").Rows(RowNumber)
Set AutoUpdateWB = Workbooks.Open(Filename:=AutoUpdateTargetFile, UpdateLinks:=3)
AutoUpdateWB.RunAutoMacros Which:=xlAutoOpen
Application.Run "Auto_Update.xls!Flat"
AutoUpdateWB.Close
End If
Next RowNumber
End Sub
AutoUpdate.xls!Flat
Sub Flat()
Dim RowNumber As Long 'Long Stores Variable
Dim SheetNumber As Long
Dim TargetFile As String 'String Stores File Path
Dim BackupFile As String
Dim CurrentWB As Workbook 'Workbook Stores Workbook
For RowNumber = 1 To (Range("File").Rows.Count - 1)
'Loops through each file in the list and assigns a workbook variable.
If (Range("File").Rows(RowNumber) <> "") Then
TargetFile = Range("Sys.Path") & Range("Path").Rows(RowNumber) & Range("File").Rows(RowNumber) 'Target File Path
BackupFile = Range("Report.Path") & Range("Path").Rows(RowNumber) & Range("SubFolder") & Range("File").Rows(RowNumber) 'Backup File Path
Set CurrentWB = Workbooks.Open(Filename:=TargetFile, UpdateLinks:=3) 'Sets CurrentWB = to that long name. This becomes the name of the workbook.
CurrentWB.RunAutoMacros Which:=xlAutoOpen 'Enables Macros in Workbook
CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=56
For SheetNumber = 1 To Sheets.Count 'Counts Worksheets in Workbook
Sheets(SheetNumber).Select 'Selects All Worksheets in Workbook
If (Sheets(SheetNumber).Name <> "What If") Then
Sheets(SheetNumber).Unprotect ("UMC626") 'Unprotects Workbook
Cells.Select 'Selects Data in Workbook
Range("B2").Activate
With Sheets(SheetNumber).UsedRange
.Value = .Value
End With
Sheets(SheetNumber).Protect Password:="UMC626", DrawingObjects:=True, Contents:=True, Scenarios:=True 'Protects Workbook
End If
Next SheetNumber 'Runs Through Iteration
Sheets(1).Select
Range("A1").Select 'Saves each workbook at the top of the page
CurrentWB.SaveAs Filename:=BackupFile, FileFormat:=56, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False 'Saves Workbook in Flatten File Location
CurrentWB.Close 'Closes Workbook
End If 'Ends Loop
Next RowNumber 'Selects Another Account
End Sub
What I have done so far.
Each Individual AutoUpdate file works when ran on its on.
If Application.Run"Auto_Update.xls!Flat" is removed from Panel.xls!Update it opens and closes all of the AutoUpdate.xls files with no error.
If I link Panel.xls!Update to only 3 of the 7 AutoUpdate files.... any 3. It runs with no errors.
I just can't seem to get it to run all 7 without saying Runtime Error 1004.
I found a microsoft work around code. Not sure how to implement it though.
Sub CopySheetTest()
Dim iTemp As Integer
Dim oBook As Workbook
Dim iCounter As Integer
' Create a new blank workbook:
iTemp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set oBook = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iTemp
' Add a defined name to the workbook
' that RefersTo a range:
oBook.Names.Add Name:="tempRange", _
RefersTo:="=Sheet1!$A$1"
' Save the workbook:
oBook.SaveAs "c:\test2.xls"
' Copy the sheet in a loop. Eventually,
' you get error 1004: Copy Method of
' Worksheet class failed.
For iCounter = 1 To 275
oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
'Uncomment this code for the workaround:
'Save, close, and reopen after every 100 iterations:
If iCounter Mod 100 = 0 Then
oBook.Close SaveChanges:=True
Set oBook = Nothing
Set oBook = Application.Workbooks.Open("c:\test2.xls")
End If
Next
End Sub
http://support.microsoft.com/kb/210684/en-us
Based on the document from Microsoft linked below this is a known issue.
Copying worksheet programmatically causes run-time error 1004 in Excel
I'm not sure how many sheets this loop in Flat but it appears that is the issue. Specifically the quote:
This problem can occur when you give the workbook a defined name and then copy the worksheet several times without first saving and closing the workbook
Due to the levels that you have created using separate workbooks I would suggest starting with limiting the scope of your Update subroutine. There are many designs for something like that but I might start with passing an integer argument back and fourth between Auto Open and Update. That way you can close and reopen Panel.xls multiple times and start exactly where you left off.
Its not clear from your text, but is your procedure "Flat" inside the files you are opening and if so is it being called by the auto open macro?
It sounds like you want to only be running your macro from your original workbook, and not firing the ones in the auto open macro of the workbooks you open.
If this is indeed the case, I do something similar in one of my workbooks, where I have an "upgrade" wizard that fires when the work book is opened, however because I am upgrading, the other workbook I open, also has the upgrade wizard, and so that used to fire as well. I resolved this by opening the other workbook in a hidden instance of excel, and within my auto open macro, I have a line of code that queries the visible state of the workbook, and does not fire if it is hidden. So in the below code its the "And Me.Application.visible" that controls if the wizard is run
'Check if the ODS code is populated or default xxx, if so invoke the upgrade wizard
'but only if the application is visible
If (ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value = "xxx" _
Or Len(ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value) = 0) _
And Me.Application.visible = True Then
'run the upgrade wizard
frmCSCWizardv8.Show
End If
This requires that you open your workbooks in a separate excel instance. The below code is the snippet of code that does this, hope this is enopugh for you to get the idea
Dim lRet
Dim i As Integer, j As Integer
Dim FoundSheet As Boolean
'Because the wizard opens the old DCS in a hidden instance of Excel, it is vital that we close this if
'anything goes wrong, so belt and braces, close it every time the user presses the button
'Switch off the error handling and the display alerts to avoid any error messages if the old dcs has
'never been opened and the hidden instance does not exist
Application.DisplayAlerts = False
On Error Resume Next
book.Close SaveChanges:=False
app.Quit
Set app = Nothing
Application.DisplayAlerts = True
'set error handling
On Error GoTo Err_Clr
'populate the status bar
Application.StatusBar = "Attempting to open File"
'Default method Uses Excel Open Dialog To Show the Files
lRet = Application.GetOpenFilename("Excel files (*.xls;*.xlsx;*.xlsm;*.xlsb), *.xls;*.xlsx;*.xlsm;*.xlsb")
'If the user selects cancel update the status to tell them
If lRet = False Then
Me.lstOpenDCSStatus.AddItem "No file selected"
'if the user has selected a file try to open it
Else
'This next section of code creates a new instance of excel to open the selected file with, as this allows us to
'open it in the background
OldDCS = lRet
Application.StatusBar = "Attempting to open File - " & lRet
app.visible = False 'Visible is False by default, so this isn't necessary, but makes readability better
Set book = app.Workbooks.Add(lRet)
Application.StatusBar = "Opened File - " & lRet
I am trying to export current workbook to HTML site with current timestamp using this code
Private Sub btnSave_Click()
ActiveWorkbook.Save 'Save current file
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String
Application.ScreenUpdating = False ' Prevents screen refreshing.
CurrentFile = ThisWorkbook.FullName ' Remeber location of original file
NewFileType = "Web files File (*.HTML), *.html" 'Set file type
Newfilename = "Shed9-" & Format(CStr(Now), "yyyy-mm-dd_hh-mm") 'Save as timestamp
NewFile = Application.GetSaveAsFilename( _
InitialFileName:=Newfilename, _
fileFilter:=NewFileType)
If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs Filename:=NewFile, _
FileFormat:=xlHtml
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
End If
Application.ScreenUpdating = True
End Sub
In theory this procedure should save current file, save copy (with a time stamp, ignoring VBA) as a web page, close the web page (which to be honest I don't even want to open) and get back to the original spreadsheet.
Unfortunately the problem is with the closing part: Excel opens the web page (!) and then I have never-ending pop-up question "Do you want to save the file "Shed-9 .html?"
So how can I remove that pop-up and simply export without opening?
EDIT
I've tried to force-save the HTML copy before closing by putting the
ActBook.Save
ActBook.Close
But that leads to an error:
"An item with the same key has already been added". If thats important the workbook has multiple sheets and data taken through PowerQuery
EDIT
(The original code came from here) - the original author should receive his/her credit
Try:
ActBook.Close False
If you save a workbook in a non-excel format it will ask you if you want to save the file again anyway, without fail. Using the optional "False" parameter tells excel that you want to close without saving.
You could safely skip these lines, where you actually ask Excel to do just that (open the file):
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
I think what might confuse you is that have turned off screen updating, which hides what happens to you (behind the scenes).
Application.ScreenUpdating = False
This is all good if you really want to hide what's going on, but I imagine it might confuse you as long you have the Workbooks.Open code.