VBA: SaveCopyAs not password protecting - excel

I have a template, that I copy data into, then suse SaveCopyAs to save it down in a different location. I want to start adding a it each time. However all that happens is it saves it down in new location without password.
Attached below is the code, the reason I use the extra (unnecessary) .Open is due to the fact I could not find a way to do it just using SaveCopyAs
Option Explicit
Sub SaveCopyAs_password()
Dim passdate As String
Dim wb, wbresults As Workbook
passdate = "hello"
Workbooks.Open ("R:\Macros\pre\Mealplan.xlsx")
Set wbresults = Workbooks("Mealplan")
wbresults.SaveCopyAs ("R:\Macros\post\Mealplan.xlsx")
Workbooks.Open ("R:\Macros\post\Mealplan.xlsx")
Workbooks("Mealplan.xlsx").Activate
Set wb = ActiveWorkbook
ActiveWorkbook.SaveAs Password:=passdate
wb.Close
End Sub

This Simple code will work for you:
Sub SaveCopyAs_password()
Dim passdate As String
Dim wbresults As Workbook
passdate = "hello"
FileCopy "R:\Macros\pre\Mealplan.xlsx", "R:\Macros\post\Mealplan.xlsx"
Set wbresults = Workbooks.Open("R:\Macros\post\Mealplan.xlsx")
wbresults.SaveAs Password:=passdate
wbresults.Close
End Sub
Another Way:
Sub SaveCopyAs_password()
Dim passdate As String
Dim wbresults As Workbook
passdate = "hello"
Set wbresults = Workbooks.Open("R:\Macros\pre\Mealplan.xlsx")
wbresults.SaveAs Filename:="R:\Macros\post\Mealplan.xlsx", Password:=passdate
wbresults.Close
End Sub
Run this Macro from any other workbook other than the 2 used in Macro.

Related

Workbook.name property does not return the name of an excel file

I use the code below to write the names of the workbooks open in Microsoft Excel in an array, but it does not return the name of a freshly open excel file that was generated from SQL Server using template file (.xltm), knowing that the user account is a domain user. So, is it because of template or the domain user account? and how can I solve this problem and get the name of such file?
For Each AWB In Application.Workbooks
If AWB.Name <> ThisWorkbook.Name Then
WB_Array(i) = AWB.Name
i = i + 1
End If
Next AWB
Thanks
Extending the great answer in the link that Tim Williams gave in the comments, if the issue is that the other workbook is open in a different instance of Excel, you won't be able to find it by just looking in Application.Workbooks. You will need to get all the open Excel.Application Objects and then check each of their Application.Workbooks collections.
Credit to Florent B. for their code. Add their code to your project. Then use the following function to collect each workbook into a Dictionary. I have included an example of how to use that function to collect all the workbook names into an array.
Sub Example()
Dim AllWorkbooks As Object
Set AllWorkbooks = GetAllWorkbooks
'AllWorkbooks.Keys() is now an array containing the names of all open workbooks
'AllWorkbooks.Items() is now an array of all open workbook objects
End Sub
Function GetAllWorkbooks() As Object
Dim xlWorkbooks As Object
Set xlWorkbooks = CreateObject("Scripting.Dictionary")
Dim xl As Application
For Each xl In GetExcelInstances()
Dim WB As Workbook
For Each WB In xl.Workbooks
If Not xlWorkbooks.Exists(WB.Name) Then xlWorkbooks.Add WB.Name, WB
Next
Next
Set GetAllWorkbooks = xlWorkbooks
End Function
Open Workbooks to Array
Option Explicit
Sub ListWorkbookNames()
Dim wbCount As Long: wbCount = Workbooks.Count
If wbCount = 1 Then
MsgBox "Only the workbook containing this code is open.", vbExclamation
Exit Sub
End If
Dim WorkbookNames() As String: ReDim WorkbookNames(1 To wbCount - 1)
Dim wb As Workbook
Dim n As Long
For Each wb In Workbooks
If Not wb Is ThisWorkbook Then
n = n + 1
WorkbookNames(n) = wb.Name
End If
Next wb
MsgBox "Found the following open workbooks:" & vbLf _
& Join(WorkbookNames, vbLf), vbInformation
End Sub

Use input box to reference another workbook into sub

I put together a sub that allows you to input the name of the file you want your sub to refer to instead of encoding a single file. However beyond the input box, I get the error "subscript out of range". I tried entering the file name with and without "" and file extension .xls
Sub tester()
Dim wbName As String
wbName = Application.InputBox("What is the workbook name?")
If Right(wbName, 4) <> ".xls" Then wbName = wbName + ".xls"
Set mainWB = Workbooks(wbName)
Dim copyThis As Range, pasteThis As Range
Set copyThis = mainWB.Worksheets(2).Columns("F")
Set pasteThis = Workbooks("VBA Workbook.xlsm").Worksheeets(1).Columns("A")
copyThis.Copy Destination:=pasteThis
End Sub
Whenever there is user intervention, you will have to use lot of error handling to avoid possible errors. I recommned using a Userform insetad. Instead of the making a user, type the workbook name, use a UserForm witm a ComboBox1 (As shown in the image below) populated with the names of all open workbooks so that user can choose the relevant workbook rather than typing the name
Code
Option Explicit
Private Sub UserForm_Initialize()
Dim wkb As Workbook
Me.Label1.Caption = "Please select the relevant workbook"
With Me.ComboBox1
'~~> Loop thorugh all open workbooks and add
'~~> their name to the Combobox
For Each wkb In Application.Workbooks
.AddItem wkb.Name
Next wkb
End With
End Sub
Private Sub CommandButton1_Click()
If ComboBox1.ListIndex = -1 Then
MsgBox "Please select a wotkbook name and try again"
Exit Sub
End If
Dim wb As Workbook
Set wb = Workbooks(ComboBox1.List(ComboBox1.ListIndex))
With wb
MsgBox .FullName
'~~> Do what you want
End With
End Sub

Object Required Run-Time Error 424 on wb.close

I'm writing a VBA code to
1. open file;
2. copy sheet and paste onto current workbook;
3. close source workbook.
Everything works fine till point number 3, where I get the Run-time error 4244 object required.
If you look at the code below, I believe the problem lies with "wb.close". I could use some help here!
New excel vba guy here trying to be more efficient
Sub ImportOriginated()
Dim fileNameAndPath As Variant
Dim SrcWbk As Workbook
fileNameAndPath = Application.GetOpenFilename(Title:="Select Origination File To Be Opened")
If fileNameAndPath = False Then Exit Sub
Workbooks.Open Filename:=fileNameAndPath
Worksheets("LoanBookLocalCurrencyfilteredby").Activate
ActiveSheet.Copy After:=Workbooks("Portfolio Reporting
Dashboard.xlsm").Sheets(Workbooks("Portfolio Reporting
Dashboard.xlsm").Worksheets.Count)
wb.Close
End Sub
The source file which I've copied from should close.
You need to Set your object before you can use it! If you add Option Explicit to the top of your code, VBA will be kind enough to notify you of mistakes like this
Option Explicit
Sub Revision()
Dim wb As Workbook
Dim ws As Worksheet
Dim fn As String
Dim Temp As Workbook
fn = Application.GetOpenFilename(Title:="Select Origination File to be Opened")
If fn <> "" Then
Set wb = Workbooks.Open(fn)
Set ws = wb.Sheets("LoanBookLocalCurrencyfilterdby")
Set Temp = Workbooks("Portfolio Reporting Dashboard.xlsm")
ws.Copy After:=Temp.Sheets(Temp.Sheets.Count)
wb.Close
End If
Problem:
No allocation of wb
No allocation of SrcWbk
Extra " in counting worksheets
Try:
Sub ImportOriginated()
Dim fileNameAndPath As Variant
Dim SrcWbk As Workbook
Dim num As Integer
fileNameAndPath = Application.GetOpenFilename(Title:="Select Origination File To Be Opened")
If fileNameAndPath = False Then Exit Sub
Set SrcWbk = Workbooks.Open(fileNameAndPath)
num = Workbooks("Portfolio Reporting Dashboard.xlsm").Worksheets.Count
Worksheets("LoanBookLocalCurrencyfilteredby").Copy After:=Workbooks("Portfolio Reporting Dashboard.xlsm").Sheets(num)
SrcWbk.Close False
End Sub

Opening an excel file & copying sheets using VBA

I need to copy a couple of excel sheets ("Y", "X") from one file to the same sheet in another excel file (call it Z - the same file that I'm using the VBA on).
my limitation is that the name and path of the first excel file (with the X,Y) are changing, therefore I'm trying to write something more generic using the "as String" and the Application.GetOpenFilename() command but I'm receiving an error.
Tried to separate into 2 different subs
Sub BrowseForFile()
Dim sFileName As String
sFileName = Application.GetOpenFilename(, , "open the file: " )
If sFileName = "false" Then Exit Sub
MsgBox sFileName
Workbooks.Open (sFileName)
Workbooks(sFileName).Sheets("X").Activate
Stop
Runtime Error 9
file doesn't find (1004 I think)
If the user presses the Cancel button then the GetOpenFilename function returns a boolean False not a string "false" so you need to test for If sFileName = False Then and declare it as Variant.
If you open a workbook always reference it to a variable so you can use that to access the workbook easily
Dim OpenedWb As Workbook
Set OpenedWb = Workbooks.Open(sFileName)
Then you can use the variable Wb to reference the workbook you opened
OpenedWb.Worksheets("X").Activate
Note that using .Select and .Activate is a bad practice and should be avoided (How to avoid using Select in Excel VBA). Instead use another reference to reference your workbook.
Dim ws As Worksheet
Set ws = OpenedWb.Worksheets("X")
And access a range like ws.Range("A1").Value for example.
Sub BrowseForFile()
Dim sFileName As Variant 'needs to be variant because cancel returns a boolean False
sFileName = Application.GetOpenFilename(, , "open the file: " )
If sFileName = False Then Exit Sub
MsgBox sFileName
Dim OpenedWb As Workbook
Set OpenedWb = Workbooks.Open(sFileName)
Dim ws As Worksheet
Set ws = OpenedWb.Worksheets("X")
MsgBox ws.Range("A1").Value 'output the value of `A1` in worksheet `X` of workbook `sFileName`
End Sub

How to get Workbook Name after opening the workbook using workbooks.open?

Workbooks.Open "C:\abc.xlsx"
Workbooks("abc").Worksheets("Sheet1").Range("A1:B7").Clear
In the above code I am opening the workbook using Workbooks.Open in first line. In the second line I am accessing the opened workbook using the workbook name.
How can I access the opened workbook without the filename in second line?
(I want to create a function and I don't want to pass both the file paths and filenames separately)
You need to use references and reference the workbook and the sheet for example:
Option Explicit
Sub OpenWorkbook()
Dim wb As Workbook, ws As Worksheet
Set wb = Workbooks.Open("C:\abc.xlsx", UpdateLinks:=False, ReadOnly:=True)
Set ws = wb.Sheets("Sheet1")
ws.Range("A1:B7").ClearContents
End Sub
Note that the parameters on the openworkbook such as Updatelinksand ReadOnly can be modified to True or Falseas you need to.
Create an object of type Excel.Workbook and open the workbook into that.
Like so
Dim w as Excel.Workbook
set w= Workbooks.Open ("C:\abc.xlsx")
and then you can say
w.worksheets.add.....
etc
You can shorten your code:
Option Explicit
Sub OpenWb()
Dim ws As Worksheet
Set ws = Workbooks.Open("C:\abc.xlsx").Worksheets("Sheet1")
With ws '<- Use With Statement to avoid sheet repetition
.Range("A1:B7").ClearContents
End With
End Sub
You can try this
Option Explicit
Sub TEST()
Dim WB As Workbook
Set WB = Workbooks.Open(Filename:="C:\abc.xlsx")
For Each WB In Workbooks
If WB.Name = "abc.xlsx" Then
WB.Worksheets(Sheet1).Range("A1:B7").ClearContents
Exit Sub
End If
Next
End Sub

Resources