Excel VBA to copy cells from password protected file into another file

[megtoma]

Hello,

I have the following code:

Sub Button1_Click()
Range("E1:E12").Value = "='C:\Users\zzz\Desktop\New folder\[source.xlsx]Sheet1'!D112"
Range("G1").Value = "='C:\Users\zzz\Desktop\New folder\[source.xlsx]Sheet1'!G1"
Sheets("Sheet1").Range("H1").Value = Format(Now, "dd-mmm-yy hh-mm-ss")
End Sub

it copies cells D112 from source.xlsx file into E1:E12 cells in my main file as well as cell G1 respectively and puts a time stamp in cell H1.

Does anyone know how the code should look like if the source.xslx is password protected??? I do not want to be prompted for a password all the time I use the macro...

Many thanks in advance.

[mikerickson]

I'm guessing that this question might fall under this site's "no bypassing excel security questions" rule.

As to your question, is Source.xlsx open? If so there are a couple of ways to test if a sheet in it is protected.

Dim flag as Boolean
On Error Resume Next
Application.DisplayAlerts = False

With Workbooks("Source.xlsx").Worksheets("Sheet1").Range("ZZ9999")
    .Value = .Value
End With

If Err Then
    MsgBox "protected sheet"
Else
    MsgBox "not"
End If

Application.DisplayAlerts=True
On Error Goto 0

[megtoma]

Hi,
This macro does not require the source.xlsx to be open. However, I need to input the password of the file. Is there any way to skip inputting the password every time I run the macro?

[GTO]

Might you mean that source.xlsx is password protected from being opened?

Regardless of that, I think that:

Range("E1:E12").Value = "='C:\Users\zzz\Desktop\New folder\[source.xlsx]Sheet1'!D1:12"

...needs to be something like:

Range("E1:E12").FormulaArray = "='C:\Users\zzz\Desktop\New folder\[source.xlsx]Sheet1'!D1:12"

Does that help?

Mark

[Aussiebear]

The password can be added to the macro if required

[megtoma]

Hi,
How do I add the password ' depo' of the source.xlsx file to the macro? I would like the macro to automatically input it.
Thank you for help.

[megtoma]

I forgot to add... It is a password to open the file.

[GTO]

Admittedly not tested, and my memory is foggy, but I do not recall building a link (formula) to the source workbook's range as being an easy way of skipping the password needed dialog. I would suggest opening each source workbook (via code), wherein the password may be passed as an argument. This way, after opening the wb, you just assign Destination.Range = Source.Range if that makes sense.

[Aussiebear]

Workbooks.Open Filename:="C:\Documents and Settings\My Documents\Book 1.xls, Password := "Your Password"

[megtoma]

Thanks for your help all.
What would be a full vba code if I want to copy cell range (Sheet1!H10:I15) located in the file source.xlsx having a path C:\Users\zzz\Desktop\New folder\[source.xlsx]Sheet1'!G1 and is password protected to open ('depo') into another file called resource.xls.
Any suggestions? At the same time I would not like the user to be prompted for the source.xls workbook password when running the macro in the workbook resource.xls.

[GTO]

Here is a simple example. I changed the path and name to match where I happen to have the file.

In a Standard Module:

Option Explicit
  
Sub example()
Dim wbSource As Workbook
Dim wksSource As Worksheet
Dim bolOpenedWB As Boolean

  '// Allow, just for one line, bypassing error handling.//
  On Error Resume Next
  Set wbSource = Workbooks("Source (pwd is 1234).xlsx")
  On Error GoTo 0
  
  If wbSource Is Nothing Then '//If wbSource was not Set, it was not open, so open it and set a reference to it.//
    Set wbSource = _
      Workbooks.Open(Filename:="E:\vbax\vbax-50371-Excel-VBA-to-copy-cells-from-password-protected-file-into-another-file\Source (pwd is 1234).xlsx", _
                     UpdateLinks:=False, _
                     ReadOnly:=True, _
                     Password:="1234")
      '// Set a flag, so we know to close it.//
      bolOpenedWB = True
  End If
  
  '//SAA; in this case, if we do not find the correct sheet in the source wb, we can handle without any big errors//
  On Error Resume Next
  Set wksSource = wbSource.Worksheets("Sheet1")
  On Error GoTo 0
  
  '// If we found the sheet, grab values; else, advise//
  If Not wksSource Is Nothing Then
    '// NOTE: I used the default CodeName of the sheet, which I like better (presuming the sheet will not be deleted)//
    Sheet1.Range("A1:B6").Value = wksSource.Range("H10:I15").Value
  Else
    MsgBox "YIKES!", vbOKOnly, vbNullString
  End If
  
  '// If we opened it, close it.//
  If bolOpenedWB Then
    wbSource.Close False
  End If
  
End Sub

See the attached...

Hope that helps,

Mark

[snb]

Look here:

http://www.vbaexpress.com/forum/show...l=1#post313255

Why doubly posted ???

[megtoma]

Thank you again for all your help. My query is solved.