Excel VBA - Create Another Excel File with Password Protected - vba

I have a Excel Program that need to create another excel with password protected. I can create another excel but i don't know how to protect it with password. Below are the code for the creating another Excel File.
Option Explicit
Sub Macro1()
Dim Wk As Workbook
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs Filename:=”B:\Test1.xlsx”
Application.DisplayAlerts = True
End Sub
Hope you guys can help for this part.

Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs FileFormat:=xlNormal, Password:="pass", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Here is the documentation: Workbook.SaveAs Method (Excel)

Related

Error in Copying a Sheet from One Workbook to an Another

Encountered below error in my vba code.
Run-time error '1004':
Copy Method of Worksheet Class failed
Public Sub ExportAsCSV(savePath)
Set ws = Workbooks("OND Estimator").Worksheets("port") 'Sheet to export as CSV
Set wb = Application.Workbooks.Add
ws.Copy Before:=wb.Worksheets(wb.Worksheets.Count)
Application.DisplayAlerts = False 'Possibly overwrite without asking
wb.SaveAs Filename:=savePath, FileFormat:=xlCSV
Application.DisplayAlerts = True
wb.Close savechanges:=False
End Sub
Just copy the worksheet to no location. This creates a new active workbook with a single worksheet (a copy of the original) ready to be saved as xlCSV.
Public Sub ExportAsCSV(savePath)
Workbooks("OND Estimator").Worksheets("port").Copy 'Sheet to export as CSV
Application.DisplayAlerts = False 'Possibly overwrite without asking
with activeworkbook
.SaveAs Filename:=savePath, FileFormat:=xlCSV
.Close savechanges:=False
end with
Application.DisplayAlerts = True
End Sub
try
Public Sub ExportAsCSV(savePath)
Application.DisplayAlerts = False 'Possibly overwrite without asking
With Workbooks("OND Estimator").Worksheets("port").Parent
.SaveAs Filename:=savePath, FileFormat:=xlCSV
.Close savechanges:=False
End With
Application.DisplayAlerts = True
End Sub
I found out the issue on this! I didn't realize hiding the sheets will cause the copy method to not work correctly...
Worksheets("port").Visible = xlVeryHidden
...so what I did is that I revealed the sheet before copying and then hid again once the copy is done.
Worksheets("port").Visible = True
Thank you guys for your helping me!

Run-time Error 9 w/Variable Workbook Name

So the user is able to import data from another excel file and I want to close the other excel file once the values have been copied into the current workbook. I can't, however, get my code to go back and select the other excel file in order to close it again.
I've already checked and it's only running one instance of Excel.
Option Explicit
Private Sub Button_ImportSubmittedData_Click()
Dim MyFile As String
Dim tempDataSetName As String
tempDataSetName = "Submitted Apps"
MyFile = Application.GetOpenFilename("Excel Files,*.xlsx")
Workbooks.OpenText Filename:=MyFile
ActiveSheet.Range("A2").Select
ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("HET.xlsm").Activate
Sheets("Submitted").Select
ActiveSheet.Range("A2").Select
ActiveSheet.Paste
Selection.Columns.AutoFit
ActiveSheet.Range("A1").Select
**Windows(MyFile).Activate**
'Application.DisplayAlerts = False
'ActiveWindow.Close
'Windows("HET.xlsm").Activate
'ActiveSheet.Range("A1").Select
End Sub

Excel VBA with Application.ScreenUpdating does not work

I have a macro in excel VBA which runs other macros. I am trying to implement Application.Screenupdating so that the user does not get to see what the macros do. However it seems to work for every macro, other than AccImport which is the main macro that I do not want my user to be aware of.
This macro does a spreadsheet transfer from excel to access, and I do not want my users to be aware of my access database. Within this macro it does a spreadsheet transfer by opening the access database, then closing it. Below is the main macro that I trigger, screenupdating=false seems to work for all the macros other than AccImport.
Any ideas? Thank you.
Sub ENTER1Dim2()
'
' ENTER1 Macro
'
'
If Worksheets("DIM21").Range("AR32") = 0 Then
MsgBox "Please enter DATA completely first"
End
Else
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!TransferE1Dim2"
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!PWDOFF"
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!ProtectE1Dim2"
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!UnprotectE2Dim2"
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!ClearE2Dim2"
Sheets("Data1").Select
Application.ScreenUpdating = False
Application.Run "'NEW.xlsm'!AccImport"
Sheets("DIM21").Select
Range("G41").Select
Application.Run "'NEW.xlsm'!PWDON"
Call AUTOSAVE
End If
Application.ScreenUpdating = True
End Sub
Macro below is AccImport.
Sub AccImport()
'Application.OnTime Now + TimeValue("00:01"), "AccImport"
Dim Acc As New Access.Application
Acc.OpenCurrentDatabase "C:\Users\yilmadu001\Desktop\Database.accdb"
Acc.DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:="Table1", _
Filename:=Application.ActiveWorkbook.FullName, _
HasFieldNames:=True, _
Range:="Data1$A1:BL40000"
Acc.CloseCurrentDatabase
Acc.Quit
Set Acc = Nothing
End Sub

Excel into CSV VBA

I am having trouble saving one sheet from my workbook into a CSV file. I have 18 sheets in the one workbook. Every time I run the macro, it saves a different sheet. I also need it so the display alerts do not pop up. I am a beginner to VBA and running macros, so any help would be appreciated.
Sub csvfile()
'
' csvfile Macro
'
'
ChDir "C:\Users\RM\Documents"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\RM\Documents\Working_Program\PSSE_Export_Data.csv", FileFormat:= _
xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
End Sub
This should do the trick, Just specify the sheet that you want to save in place of "Sheet1"
Sub csvfile()
Application.DisplayAlerts = False
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
ws.SaveAs Filename:= _
"C:\Users\RM\Documents\Working_Program\PSSE_Export_Data.csv", FileFormat:= _
xlCSV, CreateBackup:=False
End Sub

Save multiple Excel worksheets as indivudual workbooks by cell value and sheet name failure?

i've searched multiple forums to see if i can discover why a peice of code isnt working but havent found an answer yet.
My VBA isnt great and i inherited this section of code from a predecessor.
This part of the code saves each indivisual worksheet as a new workbook by using the worksheet names.
Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set OldBook = ThisWorkbook
For Each sh In OldBook.Worksheets
If sh.Visible = True Then
sh.Copy
ActiveWorkbook.SaveAs Filename:="Pathway" & "\" & sh.Name, FileFormat:=xlExcel8
ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.Close False
This works fine and will create the sheets for me but I now need to add to the file name by using the same cell value from each worksheet (B1) so i tried adding to the code.
ActiveWorkbook.SaveAs Filename:="Pathway" & "\" & sh.Range("B1").Value & sh.Name, FileFormat:=xlExcel8
However doing so results in a "Run-time error '1004': There is no active Protected View Window" but i'm not too sure why that would be?
Any help here would be much appreciated.
This is likely due to your path not being a string accepted by Windows as file name. As the problem appears when you add B1 to the path, this seems to be the source of your problem. Check if cell B1 contains any characters not allowed in file names.