Updater bauen

Hallo zusammen
Ich möchte einen Excel-Updater bauen.
Ich habe ein Tool gebaut, dass an viele verschiedene Mailempfänger versandt und auch schon gebraucht wurde. Jetzt habe ich daran einige Änderungen getätigt und möchte dies den Mailempfängern verfügbar machen, möchte aber nicht jedes Dokument einzeln aktualisieren, sondern schwebt mir etwas vor wie:
1. Jeder Empfänger bekommt eine Excel-Datei, bei der die Änderungen inbegriffen sind. Das Dokument ist so aufgebaut, dass die ersten sieben Sheets systemrelevant sind. Die Sheets von 8-.... sind Datenquellen.
2. Jetzt möchte ich bei dieser Updater-Datei ein Makro bauen dass den Datei-Öffnen-Dialog öffnet und der Mailempfänger darüber seine bestehende Datei auswählen kann. Diese sollte dann geöffnet werden und die Sheets 8-... in die Updater-Datei kopiert werden. Anschliessend sollte die Updater-Datei am gleichen Ort wie die bestehende Datei gespeichert werden.
Ich habe leider nur Ahnung innerhalb von Excel ein Makro laufen zu lassen, weiss jedoch nicht wie das Öffnen etc. funktioniert.
Ich danke schonmal jedem ganz herzlich für die Hilfe.
LG Elias

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Updater bauen

12.09.2014 16:54:30

fcs

AW: Updater bauen

12.09.2014 17:44:42

Elias

Hallo Elias,
die entsprechenden Datei-Auswahl-Dialoge werden alle von VBE-Excel bzw. Office zur Verfügung gestellt.
Als Makro könnte dann das Ganze wie folgt aussehen.
Die Empfänger der Update-Mail sollten dann aber nicht die anghängte Updatei-Datei aus der Mail heraus öffnen, sondern den Anhang speichern und die Datei von Excel aus öffnen. Das gewährleistet einen kontrollierteren Ablauf.
Gruß
Franz

Sub prcDatenUpdate()
Dim wkbUpdate As Workbook
Dim wkbAlt As Workbook, wksData As Worksheet
Dim varAuswahl As Variant, arrSheet() As String, intI As Integer
On Error GoTo Beenden
'Dateiauswahldialog anzeigen
varAuswahl = Application.GetOpenFilename( _
Filefilter:="Excel(*.xls;*.xlsx;*.xlsm;*.xlsb),*.xls;*.xlsx;*.xlsm;*.xlsb", _
Title:="Bitte alte XXX-Datei auswählen")
If varAuswahl = False Then
MsgBox "Die Aktualisierung der XXX-Datei wurde abgebrochen! " & vbLf _
& "Bitte Update nochmals starten!", _
vbInformation + vbOKOnly, "U P D A T E"
GoTo Beenden
End If
'Main-Datei-Objekte setzen
Set wkbUpdate = ActiveWorkbook
Application.ScreenUpdating = False
'alte Datei schreibgeschützt öffnen
Set wkbAlt = Application.Workbooks.Open(Filename:=varAuswahl, ReadOnly:=True)
With wkbAlt
'Sicherungskopie der alten Datei erstellen
.SaveCopyAs Filename:=.Path & "\" _
& "Copy " & Format(Now, "YYYY-MM-DD hhmmss") & .Name
If .Sheets.Count >= 8 Then
'Namen der zu kopierende Blätter in Array sammeln
ReDim arrSheet(8 To .Sheets.Count)
For intI = 8 To .Sheets.Count
arrSheet(intI) = .Sheets(intI).Name
Next
.Sheets(arrSheet).Copy after:=wkbUpdate.Sheets(wkbUpdate.Sheets.Count)
Erase arrSheet
Else
MsgBox "Keine Datentabellen in Datei vorhanden"
End If
'Daten-Datei wieder schließen
.Close savechanges:=False
End With
Set wkbAlt = Nothing
wkbUpdate.Activate
Application.ScreenUpdating = True
With Application.FileDialog(msoFileDialogSaveAs)
.Title = "Bitte Update-Datei unter neuem Namen speichern"
.InitialFileName = "XXX-Datei V2"
.FilterIndex = 2 '1= xlsx (Standard), 2 = xlsm
If .Show = -1 Then
wkbUpdate.SaveAs Filename:=.SelectedItems(1), addtomru:=True
MsgBox "Datei wurde erfolgreich aktualisiert", _
vbInformation + vbOKOnly, "U P D A T E"
Else
MsgBox "peichern der aktualisierten Datei wurde abgebrochen!", _
vbInformation + vbOKOnly, "U P D A T E"
End If
End With
Beenden:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
If Not wkbAlt Is Nothing Then wkbAlt.Close savechanges:=False
End Select
End With
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread