Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Updater bauen

Betrifft: Updater bauen von: Elias
Geschrieben am: 12.09.2014 15:10:41

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

  

Betrifft: AW: Updater bauen von: fcs
Geschrieben am: 12.09.2014 16:54:30

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



  

Betrifft: AW: Updater bauen von: Elias
Geschrieben am: 12.09.2014 17:44:42

Hallo Franz

Wooooow daanke vielmals!!! Das ist ja gerade Pfannenfertig :-)

LG Elias