doppelter laufwerk

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: doppelter laufwerk
von: domi
Geschrieben am: 22.06.2015 13:02:01

Hallo zusammen.
Wir haben ein gemeinsamen Laufwerk G: mit der Dateiname Arbeit.xls.
Meine Kollegin schreibt täglich werte und Daten rein.
Kann ich mir das tabellenblatt Personalnummer(Dateiname ist Arbeit.xls) ohne das ich die Datei aufmache auf mein HauptExcel per Schnellzugriff holen?
Auch wenn sie gerade in der Datei drin ist?
Jede Antwort hilft mir. Danke
LG domi

Bild

Betrifft: AW: doppelter laufwerk
von: fcs
Geschrieben am: 22.06.2015 22:26:35
Hallo domi,
was ist ei dir "...per Schnellzugriff holen?"
Grundsätzlich kannst du die Datei schreibgeschützt öffnen. Dann wird der zuletzt gespeicherte Stand der Datei geöffnet und du kannst beliebig Informationen aus der Datei übernehmen.
Ohne öffnen der Datei ist nur eine Übernahme der Daten per Formel möglich.
Das Auslesen der Daten via Menü Daten--Externe Daten abrufen--Aus anderen Quellen--Von Microsoft Querry ist auch möglich. Kann aber auch Probleme bereiten, wenn beimAnlegen der Querry die Datei gerade geöffnet ist.
Gruß
Franz

Bild

Betrifft: AW: doppelter laufwerk
von: domi
Geschrieben am: 22.06.2015 23:02:10
Hallo franz,
per Schnellzugriff holen?" Meine ich z.b in der RegisterDatei ein Makro mit einfügen
Lg domi

Bild

Betrifft: AW: doppelter laufwerk
von: domi
Geschrieben am: 23.06.2015 19:47:56
Die Datei wo ich hole kann geöffnet oder bzw. Geschlossen sein. Wenn sie geöffnet ist, dann bis zum letzten speichern, da meine Kollegin noch in der Datei drin ist oder vergessen hat zu schließen.
Gibt es dafür einen VBA code
Lg domi

Bild

Betrifft: AW: doppelter laufwerk
von: fcs
Geschrieben am: 23.06.2015 20:06:27
Hallo domi,
nachfolgend ein Makro und 2 Functions, die du dir dann entsprechend einbauen/anpassen musst.
Gruß
Franz

'Makro erstellt unter Excel 2010 -WIndows Vista
'Makros in einem allgemeinen Modul der Datei einfuegen und dann einer Schaltflaeche zuweisen
Sub Tab_Personalnummer_aus_Arbeit_xls_holen()
    Dim wkbZiel As Workbook
    Dim wkbArbeit As Workbook
    Dim strPfad As String, strDatei As String, strPfadDatei As String
    Dim strBlatt As String, strMsg As String
    
'in den naechsten 3 Zeilen Pfad und Namen ggf. anpassen
    strPfad = "G:"  'ohne "\" am Ende !!!
    strDatei = "Arbeit.xls"
    strBlatt = "Personalnummer"
    
    strPfadDatei = strPfad & Application.PathSeparator & strDatei
    
    strMsg = "Tabelle ""Personalnummer"" aus " & strDatei & " kopieren"
    Application.ScreenUpdating = False
'Prüfung, ob Datei existiert
    If Dir(strPfadDatei) = "" Then
        MsgBox "Datei" & vbLf & strPfadDatei & vbLf & "nicht gefunden!", vbOKOnly, strMsg
'Prüfung, ob Datei in Anwendung geöffnet ist
    ElseIf fncWorkbookOpen(strWorkbook:=strDatei) = True Then
        MsgBox "Datei""" & strDatei & vbLf & """ ist geöffnet!" & vbLf _
            & "Bitte Datei erst schließen", vbOKOnly, strMsg
    Else
        Set wkbZiel = ActiveWorkbook
'Prüfung, ob Blatt in Zieldatei vorhanden
        If fncSheetVorhanden(strSheet:=strBlatt, wkb:=wkbZiel) Then
              Select Case MsgBox("Blatt """ & strBlatt & """ ist schon vorhanden! " & vbLf _
                & "Blatt löschen?", vbQuestion + vbOKCancel, strMsg)
                Case vbOK
                    Application.DisplayAlerts = False
                    wkbZiel.Sheets(strBlatt).Delete
                    Application.DisplayAlerts = True
                Case vbCancel
                    GoTo Beenden
              End Select
        End If
        Set wkbArbeit = Application.Workbooks.Open(Filename:=strPfadDatei, ReadOnly:=True)
'Prüfung, ob Blatt in Quelldatei vorhanden
        If fncSheetVorhanden(strSheet:=strBlatt, wkb:=wkbArbeit) Then
            wkbArbeit.Worksheets("Personalnummer").Copy after:=wkbZiel.Sheets(1)
        Else
            MsgBox "Blatt """ & strBlatt & """ in Datei """ & strDatei & """ nicht vorhanden! ", _
 _
                vbQuestion + vbOKCancel, strMsg
        End If
        wkbArbeit.Close savechanges:=False
    End If
Beenden:
    Application.ScreenUpdating = True
End Sub
Public Function fncSheetVorhanden(strSheet As String, Optional wkb As Workbook) As Boolean
    'Prüft, ob Blatt strSheet in Workbook schon vorhanden
    Dim objSheet
    If wkb Is Nothing Then Set wkb = ActiveWorkbook
    On Error GoTo Fehler
    Set objSheet = wkb.Sheets(strSheet)
    fncSheetVorhanden = True
Fehler:
    
End Function
Public Function fncWorkbookOpen(strWorkbook As String) As Boolean
    'Prüft, ob Arbeitsmappe strWorkbook in aktiver Excel-Anwendung nicht geöffnet ist
    Dim wkb As Workbook
    On Error GoTo Fehler
    Set wkb = Application.Workbooks(strWorkbook)
    fncWorkbookOpen = True
Fehler:
End Function


 Bild

Beiträge aus den Excel-Beispielen zum Thema "doppelter laufwerk"