Office: VBA Daten auf geschützter und geschlossener Datei holen, pleace help!!

Hallo @ all,

ich benötige mal wieder etwas Hilfe.
Ich hole Daten aus einer geschlossenen Datei mittels Makro.

Dieses funktioniert auch sehr gut.
Nun soll aber die Datei Passwortgeschützt werden, und ich sollte das PW. dem Makro zufügen, so dasss beim ausführen keine PW Eingabe erforderlich ist.

Könnt Ihr mir dabei bitte helfen, ich steh auf dem schlauch.

Hier der code bzs die Funktion:


Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, _
sourceSheet As String, _
SourceRange As String, _
TargetRange As Range) As Boolean

'Holt einen Bereich aus einer _geschlossenen_ Arbeitsmappe
'Nur in VBA zu verwenden; nicht aus einer Tabellenzelle heraus
'05.07.2011 - Anpassung für Apostroph im Dateinamen
'© t.ramel@mvps.org

Dim strQuelle As String
Dim Zeilen As Long
Dim Spalten As Byte

On Error GoTo InvalidInput

strQuelle = "'" & SourcePath & "[" & Replace(SourceFile, "'", "''") & "]" & _
sourceSheet & "'!" & _
Range(SourceRange).Cells(1, 1).Address(0, 0)

Zeilen = Range(SourceRange).Rows.Count
Spalten = Range(SourceRange).Columns.Count

With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
.Value = .Value
End With

GetDataClosedWB = True
Exit Function

InvalidInput:
MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", _
vbExclamation, "Get data from closed Workbook"
GetDataClosedWB = False
End Function


------------------------------
und der Code zum ausführen:

Public Sub HoleDaten3()
Dim Pfad As String
Dim Dateiname As String
Dim Blatt As String
Dim Zellen As String

Pfad = "J:\Datenerfassung\Personal\Schichteinteilung\"
Dateiname = "Schichteinteilung bearbeiten Team A.xlsm"
Blatt = "Übersicht Schicht 2"
Zellen = "B3:E26"

If GetDataClosedWB(Pfad, _
Dateiname, _
Blatt, _
Zellen, _
Worksheets("Einteilung Schicht 2").Range("B3")) Then
MsgBox "Daten importiert"
End If
End Sub

PS: Ich weiss, es wäre auch eine Möglichkeit die Datei im Hintergrund zu öffnen, wäre mir aber lieber die Daten mit diesem Makro aus geschlossener Datei abzuholen.

Danke!

Grüße

 

Moinsens!

Genau genommen nicht... ;-) Genau genommen schreibst Du per Makro eine Formel, die dann die Werte holt. Das ist, bei Deiner Fragestellung, leider der entscheidende Unterschied.

Code:

.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
.Value = .Value

Hier wird eine Formel in die Zelle gesetzt, die sich aus der anderen Mappe den Wert holt. Direkt danach wird das Ergebnis der Formel mit dem Wert selbst ersetzt.

Code:

PS: Ich weiss, es wäre auch eine Möglichkeit die Datei im Hintergrund zu öffnen, wäre mir aber lieber die Daten mit diesem Makro aus geschlossener Datei abzuholen.

Dann wird das nicht gehen.

Bei der Formel-Lösung überläßt Du die Kontrolle über das Holen / Berechnen des Ergebnisses komplett Excel. Da kann nicht mehr per VBA eingegriffen werden.

Gruß, Michael

 

Hallo,

erstmal danke für die Info.

DH. die Lösung ist hier wirklich nur Datei öffnen, Daten kopieren und einfügen?
Eine andere Möglichkeit gibt es nicht? Also dass die Datei geschlossen bleibt, aus der die Daten geholt werden sollen...

Nochmals Danke und Grüße

 

Hi nochmals,

ich habe mich jetzt damit beschäftift, die Dateien im Hintergrund zu öffnen.
Was ich auch bis dahin geschafft habe...

Wo ich noch ein Problem mit habe, das Makro übernimmt auch die Formel in der Zelle die kopiert werden soll.
Ich möchte allerdings nur den Inhalt der Zelle wiedergeben, nicht die Formel...

Das müsste doch auch zu machen sein, oder?
Übrigens stellt sich mir noch immer die Frage, ob dass mit der geschlossenen und PW-geschützten Datei auch geht, also mit einem anderen Code als den in meinem ersten Post...

Hier das Makro und Danke für die Hilfe...


Sub Datenübernahme()

ActiveSheet.Unprotect ("XXX")

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Workbooks.Open Filename:="J:\conqdat\Datenerfassung C 1+2\Personal\Schichteinteilung\Schichteinteilung alle Schichten\Schichteinteilung bearbeiten Team A.xlsm", Password:="XXX", ReadOnly:=True
Workbooks("Schichteinteilung bearbeiten Team A").Worksheets("Übersicht Schicht 2").Range("B3:E26").Copy _
Destination:=ThisWorkbook.ActiveSheet.Range("B3:E26")
ActiveWindow.Close SaveChanges:=False

Workbooks.Open Filename:="J:\conqdat\Datenerfassung C 1+2\Personal\Schichteinteilung\Schichteinteilung alle Schichten\Schichteinteilung bearbeiten Team B.xlsm", Password:="XXX", ReadOnly:=True
Workbooks("Schichteinteilung bearbeiten Team B").Worksheets("Übersicht Schicht 2").Range("B3:E26").Copy _
Destination:=ThisWorkbook.ActiveSheet.Range("H3:K26")
ActiveWindow.Close SaveChanges:=False



ActiveSheet.Protect ("XXX"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True


With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With


End Sub

 

Moinsens!

Jup, mit ".copy" wird die Zelle komplett kopiert, mit allen Formaten und ggf. auch der Formel, statt des Wertes selbst. Du hast 2 bis 3 Möglichkeiten alternativ:

a) Du übernimmst einfach den Wert, ohne .copy - Das klappt aber nur mit einzelnen Zellen. So in der Art:

Code:

ThisWorkbook.ActiveSheet.Range("B3").Value = Workbooks("Schichteinteilung bearbeiten Team A").Worksheets("Übersicht Schicht 2").Range("B3").Value

b) Du kopierst die Zelle (hast damit auch die Formatierung) und ersetzt danach die Formel durch den Ergebnis-Wert, klappt auch wieder nur mit einzelnen Zellen:

Code:

Workbooks("Schichteinteilung bearbeiten Team A").Worksheets("Übersicht Schicht 2").Range("B3:E26").Copy Destination:=ThisWorkbook.ActiveSheet.Range("B3:E26")
ThisWorkbook.ActiveSheet.Range("B3").Value = ThisWorkbook.ActiveSheet.Range("B3").Value

c) Du benutzt nicht .copy mit dem "destination" Parameter, sondern kopierst nur in die Zwischenablage und benutzt dann .pastespecial. Das geht auch über ganze Bereiche von Zellen:

Code:

Workbooks("Schichteinteilung bearbeiten Team A").Worksheets("Übersicht Schicht 2").Range("B3:E26").Copy
ThisWorkbook.ActiveSheet.Range("B3:E26").pastespecial paste:=xlpastevalues

Gruß, Michael

 

Hallo Michael,

vielen Dank für deine Hilfe, ich kann nun meine Daten so übertragen wie ich es mir Vorgestellt habe.
Ich habe mich für Version B entschieden, übrigens klappt das auch für den ganzen Bereich.

Vielen Dank nochmals,

Grüße
marcel