I found the following code on this web site "save Excel file as CSV" is there any way with help of you'll I can auto run this code on specific time (11:00 pm every night), and save file name as current date (hr2015-05-05), any help will be greatly appreciated. Thanks
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set Sourcewb = ActiveWorkbook
TempFileName = Sourcewb.FullName + ".csv"
'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Save the new workbook and close it
With Destwb
.SaveAs Filename:=TempFileName, FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges
.Close SaveChanges:=False
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Edit fixed tag issue
I would do this one of two ways.
One would be through windows task scheduler. Where you will set up a task to open Excel and run it that way. See http://www.mrexcel.com/forum/excel-questions/302970-task-scheduler-vbulletin-script-auto-open-excel.html
Or
Use the code
Application.OnTime TimeValue("23:00:00"), SUBNAMEHERE
Changing SUBNAMEHERE to the sub where the code is. Not sure if it will run the beforesave part through
EDIT added code to have filename
Change TempFileName = Sourcewb.FullName + ".csv" to be
TempFileName = Sourcewb.FullName & " hr" & format(now,"YYYY-MM-DD") & ".csv"
Related
I am very new to vba/macros, I created a macro that splits multiple sheets into new excel file. However, I get 1004 error when I run the macro.
Below is my code.
Private Sub CommandButton2_Click()
Dim workbookPath As String
workbookPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each wSheet In ThisWorkbook.Sheets
wSheet.Copy
Application.ActiveWorkbook.SaveAs Filename:=workbookPath & "C\Path.xlsm" & wSheet.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Note macro button I have created in sheet1 named "Part1" and want to create new files from next sheet onwards. Please help....
You are trying to insert two paths into your line of code.
Since you defined the workbookPath variable you don't need to use "C\Path.xlsm". You need to remove "C\Path.xlsm" and insert "\" before wSheet.Name. see basic code below.
Comment out the Debug.Print(s) after you have used to verify.
Dim workbookPath As String: workbookPath = ThisWorkbook.Path 'ThisWorkbook is the macro enabled workbook.
Debug.Print ThisWorkbook.Path 'open the immediate window to varify to verify the path of the macro enabled workbook.
For Each wSheet In ThisWorkbook.Sheets
wSheet.Copy
ActiveWorkbook.SaveAs Filename:=workbookPath & "\" & wSheet.Name & ".xlsx"
'When you save a sheet as a workbook it becomes the activeworkbook
Debug.Print ActiveWorkbook.Path & "\"; ActiveWorkbook.Name 'use to verify the path of the new workbook.
ActiveWorkbook.Close False
Next wSheet
End Sub
I am trying to create a copy of my workbook when saving but when I create that copy, lock all cells so they can't be changed.
Here is what I have...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FName As String
Dim FPath As String
Dim NewBook As Workbook
FPath = ThisWorkbook.Path & "\" '& FName
FName = "Saved File" & Format(Date, "YYMMDD") & ".xlsx"
Set NewBook = Workbooks.Add
Application.DisplayAlerts = False
ThisWorkbook.Sheets.Copy
ActiveWorkbook.SaveAs Filename:=FPath & FName, FileFormat:=51
ActiveWorkbook.Close
Application.DisplayAlerts = True
'NewBook.SaveAs Filename:=FPath & FName, FileFormat:=51
Application.DisplayAlerts = False
NewBook.Close
Application.DisplayAlerts = True
End Sub
Any help would be much appreciated.
Many thanks in advance
In your case, you can use usedrange.locked to lock the entire used range of the new workbook. However this does not prevent editing until the workbook is protected, so best to do that as well with worksheet.protect. Full code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FName As String
Dim FPath As String
ThisWorkbook.Activate
FPath = ThisWorkbook.Path & "\" '& FName
FName = "Saved File" & Format(Date, "YYMMDD") & ".xlsx"
Application.DisplayAlerts = False
ThisWorkbook.Sheets.Copy
With ActiveWorkbook
.Sheets(1).UsedRange.Locked = True
.Sheets(1).Protect ""
.SaveAs Filename:=FPath & FName, FileFormat:=51
.Close
End With
Application.DisplayAlerts = True
End Sub
Note, usedrange is normally not the best practise to cover the entire range as it sometimes goes too large. However in your case you need to make sure all cells in the sheet are covered. Since all cells are protected by default when unchanged, usedrange will do the trick here nicely for the rest.
Edit, I glossed over most of the code as only the protect was relevant to the question. However as per comments, this leads to an issue. What happens is that you create a new workbook, and then copy the workbook with your code. This automatically creates a new workbook as well. This is the one which is saved, and newbook is closed without anything changed to it. I removed this part of the code. ActiveWorkbook after you copy should be the one containing your copied data, so I made this the one being locked and saved.
I have the following code that is working but the line .close closes the WB without saving:
Option Explicit
Public Function updateStatus(fpath As String, fname As String, num As String)
Dim wk As String, yr As String
Dim owb As Workbook
Dim trow As Variant
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
Set owb = Application.Workbooks.Open(fpath & fname)
trow = owb.Sheets(1).Range("Change" & num).Row
owb.Sheets(1).Cells(trow, 5).value = "Test"
With owb
.Save
.Close SaveChanges:=True 'This line doesn't seem to work
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
End With
End Function
If I remove the line, the WB stays open and I see the change. If I add the line, and open the specific file, I see no change.
As mentioned in the comments, the code looks ok, you probably have some Data Protection enabled on your Excel, which does not allow the saving. Try to make a minimal example like this:
Option Explicit
Public Sub TestMe()
Dim owb As Workbook
Set owb = Application.Workbooks.Open("C:\Users\vityata\Desktop\Testing.xlsx")
owb.Save
owb.Close
End Sub
Then debug with F8 and see the message that you got, once you go pass by owb.Save.
Just that you know:
.Save
.Close SaveChanges:=True
With the .Save line you make the SaveChanges:=True part useless. And vice versa.
I'm trying to open set of files from a specific folder. But while trying to open one of the files i get the attached Sign In pop-up.
email signin
I don't know how to get rid of this because we don't want someone to manually undo this, also, i'm cancelling the pop-up I get below pop-up
I just click No/Yes i get a Run time error.
But the designated file is open (Daily Testing Inventory file).
Here's my macro that I achieved so far:
Dim MyFolder As String
Dim MyFile As String
Application.ScreenUpdating = False
Application.EnableEvents = False
MyFolder = "C:\"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
DoEvents
Loop
I'm a newbie as far as Excel VBA is concerned. (Since I don't have enough reputation can't post all the images)
You are not reading the next file name. hence the loop is infinite.
Please add the following line above "DoEvents":
MyFile = Dir()
Turn off Alerts as well
better synatx as well
use a Workbook object to hold the opened workbooks
do your code
close each Workbook (the code below does so without saving)
then trigger your next loop
code
Sub recut()
Dim MyFolder As String
Dim MyFile As String
Dim Wb As Workbook
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
MyFolder = "C:\"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Set Wb = Workbooks.Open(MyFolder & "\" & MyFile)
'do code
Wb.Close False
MyFile = Dir
Loop
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
I'm new to VBA and am having an issue developing the code below. The code will hopefully run through about 500+ files and extract some data from various cells. Once I get this issue with the enableevents out the way.
At present, every xls file pops up with the “enable or disable macro” box. Any help will be great.
Sub ProcessAll(Optional sPath As Variant)
Dim WB As Workbook, sFile As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
If IsMissing(sPath) Then
sPath = "U:\Desktop\Temp\PEP Temp\"
sFile = Dir(sPath & "*.xls")
End If
'Loop through all .xls-Files in that path
Do While sFile <> ""
Set WB = Workbooks.Open(sPath & sFile, , ReadOnly = True, , , , , , , , Notify = False)
Debug.Print WB.Name
WB.Close False
sFile = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
After doing some research i found that you can force excel to select disable macros with the following line of code
Application.AutomationSecurity = msoAutomationSecurityForceDisable
From Excel Menu:
Files > Confidentiality center > Parameters > macros Parameters > choose wich one you need.
i tried to turn it into a vba macro using develeopper> record macro, but no success...
so i think you must do it manually.