Plötzliches Problem: OneDrive VBA Pfad

[tyr0n]

Hallo Community,

seit heute morgen funktionieren die Excel VBAs bei meiner Kollegin nicht mehr.

Wir arbeiten in einem Team von 5 Personen in einer OneDrive Freigabe. Bei 4 Personen funktioniert alles, bei einer Person erscheint ein Fehler beim Ausführen des Makros.

So schaut es bei den Kollegen aus bei denen es Funktioniert:

   

So bei der Kollegin mit den Problemen:

   

Ich habe auch schon OneDrive gelöscht, alle Ordner gelöscht, OneDrive neuinstalliert und die Freigabe wieder hinzugefügt. Leider ohne Erfolg. Ich bin ratlos!

Kann mir jemand hierbei helfen? Ist sicherlich eine Einstellung in Excel oder OneDrive?

Vielen Dank im Voraus.

Grüße tyr0n

[tyr0n]

Erledigt! Office deinstalliert und neuinstalliert hat das Problem behoben 

[tyr0n]

Und wieder da! :( Kann jemand dieses Problem nachvollziehen?

[schauan]

Hallöchen,

so wie es ausschaut funktioniert es mit einer lokalen Kopie bzw. Bearbeitung in der Desktopanwendung ...

[tyr0n]

Guten Morgen,

wir gehen alle über den Weg Explorer -> OneDrive - Firma -> Freigabeordner -> Datei.
Aber manchmal schaut es so aus als würde die Datei aus dem http geöffnet werden. (Ich kenne mich da nicht aus)

[tyr0n]

Guten Morgen,

nun habe auch ich das Problem. Aus dem nichts leitet mich ThisWorkbook.Path auf die http://sharepoint... anstatts auf c:\User\OneDrive

   

   

Sub makeProjekt()
ActiveWorkbook.Save
Dim cStrPfad As String
  
Dim strQuelle As String
Dim strZiel As String
Dim strPrüfDateinameOhneIndex As String, tempName As String
Dim objWorkbook As Workbook
Dim vntValue1 As Variant
Dim vntValue2 As Variant
Dim vntValue3 As Variant
Dim vntValue4 As Variant
Dim vntValue5 As Variant
Dim i As Long

cStrPfad = ThisWorkbook.Path & "\2020 Angebote\"

vntValue1 = Cells(ActiveCell.Row, 1).Value
vntValue2 = Cells(ActiveCell.Row, 3).Value
vntValue4 = Cells(ActiveCell.Row, 4).Value
vntValue3 = Cells(ActiveCell.Row, 6).Value
vntValue5 = Cells(ActiveCell.Row, 2).Value

strPrüfDateinameOhneIndex = Left(vntValue1, Len(vntValue1) - 1)

i = 0
tempName = Dir(cStrPfad & strPrüfDateinameOhneIndex & "? " & "*.xlsm*")
Do While tempName > ""
   i = i + 1
   strZiel = cStrPfad & tempName
   tempName = Dir
Loop

Select Case i
   Case 0
      'erstelle eine neue Datei
       strQuelle = ThisWorkbook.Path & "\programm\Vorlage_Projekt.xlsm"
      strZiel = cStrPfad & vntValue1 & " " & vntValue2 & " " & vntValue4 & ".xlsm"
      Call FileCopy(strQuelle, strZiel)
      
    Set objWorkbook = Workbooks.Open(strZiel)
    objWorkbook.Worksheets("Start").Cells(2, 4).Value = vntValue1
    objWorkbook.Worksheets("Start").Cells(3, 4).Value = vntValue2
    objWorkbook.Worksheets("Start").Cells(3, 5).Value = vntValue5
    objWorkbook.Worksheets("Start").Cells(5, 4).Value = vntValue3
    objWorkbook.Worksheets("Start").Cells(4, 4).Value = vntValue4
Set objWorkbook = Nothing
   Case 1
     Set objWorkbook = Workbooks.Open(strZiel)
     Set objWorkbook = Nothing
   Case Is > 1
      'wähle eine Datei aus
      With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = cStrPfad & strPrüfDateinameOhneIndex & "? " & "*.xlsm*"
        If .Show = True Then
          strZiel = .SelectedItems(1)
          Set objWorkbook = Workbooks.Open(strZiel)
          Set objWorkbook = Nothing
        Else
          MsgBox "Keine Datei gewählt - Abbruch"
          Exit Sub
        End If
      End With
End Select
ActiveWorkbook.Save

End Sub 

Gibt es eine andere Möglichkeit sodass Dateien auf einen OneDrive erstellt werden können? Oder gibt es einen Ersatz für ThisWorkBook.Path die auf OneDrive funktioniert?

Das alles hat nun seit einem Jahr problemlos funktioniert :(
Vielleicht kennt jemand dieses Phänomen?
Viele Grüße tyron

[maninweb]

Hallo,

habe ich noch bei mir gefunden ...

Code:

Public Function GetPath() As String
   
    Dim c As Long
    Dim n As Long
   
    Dim d As String
    Dim f As String
    Dim o As String
    Dim r As String
    Dim s As String
   
'   Errors...
   
    On Error Resume Next
   
'   Filename...
   
    f = ""
    f = ThisWorkbook.FullName
   
'   Separator...
   
    If InStr(1, LCase(f), "/") > 0 Then
     
      s = "/"
     
    Else
     
      s = Application.PathSeparator
     
    End If
   
'   Check...
   
    If Left(LCase(f), 8) <> "https://" Then
     
      r = f
     
    Else
     
'     Check...
     
      If InStr(1, LCase(f), "my.sharepoint.com") > 0 Then
       
'       Search.Commercial...
       
        c = InStr(1, LCase(f), s & "documents") + Len(s & "documents")
       
      Else
       
'       Search.Personal (https://d.docs.live.net/user-id/)...
       
        For n = 1 To 4
         
          c = InStr(c + 1, f, s)
         
        Next
       
      End If
     
'     Folder...
     
      d = Replace(Mid(f, c), s, Application.PathSeparator)
     
'     OneDrive...
     
      For n = 1 To 3
       
'       Try...
       
        o = ""
        o = Environ(Choose(n, "OneDriveCommercial", "OneDriveConsumer", "OneDrive"))
       
'       Check...
       
        If Len(o) > 0 Then
         
          Exit For
         
        End If
       
      Next
     
'     Check...
     
      If Len(o) > 0 Then
       
        r = o & d
       
      Else
       
        r = f
       
      End If
     
    End If
   
'   Check...
   
    If Len(r) > 0 Then
     
'     Path...
     
      f = StrReverse(Split(StrReverse(r), s)(0))
      r = Left(r, Len(r) - Len(f) - 1)
     
    End If
   
'   Return...
   
    GetPath = r
   
  End Function

Statt ThisWorkbook.Path dann GetPath nehmen. Sucht Dir den lokalen Ordner zu OneDrive raus.

Gruß

[tyr0n]

Hallo! Das scheint in die richtige richtung zu gehen!!! Allerdings spukt mir GetPath auch den Dateinamen.xlsm aus

GetPath spuckt mir den Pfad inkl. der aktuellen Datei aus:

C:\Users\xxxxx\OneDrive\Angebote\Angebotsliste 2020.xlsm

Ich muss also irgendwie Angebotsliste 2020.xlsm aus dem Pfad bekommen.

Richtig wäre: C:\Users\xxxxx\OneDrive\Angebote

Wie bekomme ich das hin?

Viele Grüße tyron


Edit://

Ich könnte mir vorstellen das ich in der GetPath im folgenden Bereich:

'    Path...
      f = StrReverse(Split(StrReverse(r), s)(0))
      r = Left(r, Len(r) - Len(f) - 1)
    End If
'  Return...
    GetPath = r

den Dateinamen.xlsm löschen muss.. ?

[RPP63]

Moin!
Z.Bsp. so (anpassen kannst Du sicherlich selbst):

Sub OhneDateinamen()
Const FP$ = "C:\Users\xxxxx\OneDrive\Angebote\Angebotsliste 2020.xlsm"
Debug.Print Left(FP, InStrRev(FP, "\") - 1)
End Sub

Gruß Ralf

[tyr0n]

Hallo Ralf,

Edit:// ich glaube ich habs!

r = Left(r, InStrRev(r, "\") - 1)
    End If  
GetPath = r