Pfad von der Datei vorgeben

  • Excel

Es gibt 20 Antworten in diesem Thema. Der letzte Beitrag () ist von SZR2D.

    Pfad von der Datei vorgeben

    Hallo Zusammen, ich brauche mal wieder eure Hilfe...
    Ich habe einen Makro, der mir einen Screenshot von einer vorgegebenen Range macht und es dann exportiert:

    Visual Basic-Quellcode

    1. Sub CopyRangeToJpeg()
    2. Dim aChart As Chart, rng As Range, Path As String
    3. myFileName = "#" & Sheets("MSB").Range("c2").Text & ".jpg"
    4. Path = "C:\Users\abs23zz\3M\Tier 1 Board LOK - MSB" & "\" & myFileName
    6. Set rng = Sheets("MSB").Range("B1:g23")
    9. Call rng.CopyPicture(xlScreen, xlPicture)
    10. With Sheets.Add
    11. .Shapes.AddChart
    12. .Activate
    13. .Shapes.Item(1).Select
    14. Set aChart = ActiveChart
    15. .Shapes.Item(1).Line.Visible = msoFalse
    16. .Shapes.Item(1).Width = rng.Width
    17. .Shapes.Item(1).Height = rng.Height
    18. aChart.Paste
    19. aChart.Export Path
    21. Application.DisplayAlerts = False
    22. .Delete
    23. Application.DisplayAlerts = True
    24. End With
    25. MsgBox "Saved to " & vbCr & Path, vbInformation, ""
    26. End Sub



    Es funktioniert soweit, wie es sollte. Das Problem liegt beim User:

    Visual Basic-Quellcode

    1. Path = "C:\Users\abs23zz\3M\Tier 1 Board LOK - MSB" & "\" & myFileName

    Wenn sich ein anderer User einloggt, wird der Ordner logischerweise nicht mehr gefunden.
    Kann man dem Makro irgendwie vorgeben, dass ein Screenshot immer unter dem gleichen Pfad gespeichert wird, wo auch die Excel Datei abgelegt ist?

    Vielen Dank im Voraus

    SZR2D schrieb:

    Wenn sich ein anderer User einloggt, wird der Ordner logischerweise nicht mehr gefunden.
    Den User bekommst du mit Environ("USERNAME").
    Evtl. musst du noch sicherstellen, dass das Zielverzeichnis auch existiert, sonst vor dem Speichern das Verzeichnis anlegen.

    SZR2D schrieb:

    Kann man dem Makro irgendwie vorgeben, dass ein Screenshot immer unter dem gleichen Pfad gespeichert wird, wo auch die Excel Datei abgelegt ist?
    ThisWorkbook.Path
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „petaod“ ()

    Hi, probier mal statt dem absoluten Pfad CurDir() aus, das gibt dir soweit ich weiß den aktuellen Arbeitspfad aus.
    Benutze kein VBA, aber ich denke mal, dass dies der Ersatz für .Net's CurrenDirectory ist.

    Edit: Ok, glaube hab die Frage falsch verstanden.


    Meine Website:
    www.renebischof.de

    Meine erste App (Android):
    PartyPalooza

    Hi

    Deine Datei liegt offensichtlich in Deinem Benutzerprofil unter C:\Users\abs23zz auf dem ein anderer, angemeldeter User keinen Zugriff hat. Von daher, lege die Exceldatei dort ab wo alle angemeldeten Benutzer Zugriff haben.
    Mfg -Franky-

    Hallo @SZR2D,

    mit den nachfolgenden Funktionen kannst du den Usernamen und die Systemverzeichnisse (z. B. Eigene Dokumente) für jeden Benutzer ermitteln. Damit sollte dann dein Problem sich erledigen.


    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Option Explicit
    3. ' Ordner-Auflistung
    4. Public Enum SpecialFolderIDs
    5. sfidDESKTOP = &H0 ' Desktop
    6. sfidINTERNET = &H1 ' Internet Explorer (icon on desktop)
    7. sfidPROGRAMS = &H2 ' Start Menu\Programs
    8. sfidCONTROLS = &H3 ' My Computer\Control Panel
    9. sfidPRINTERS = &H4 ' My Computer\Printers
    10. sfidPERSONAL = &H5 ' My Documents
    11. sfidMyDocuments = &H5 ' My Documents
    12. sfidFAVORITES = &H6 ' \Favorites
    13. sfidSTARTUP = &H7 ' StartMenu\Programs\Startup
    14. sfidRECENT = &H8 ' \Recent
    15. sfidSENDTO = &H9 ' \SendTo
    16. sfidBITBUCKET = &HA ' \Recycle Bin
    17. sfidSTARTMENU = &HB ' \StartMenu
    18. sfidDESKTOPDIRECTORY = &H10 ' name>\Desktop
    19. sfidDRIVERS = &H11 ' My Computer
    20. sfidNETWORK = &H12 ' Network Neighborhood
    21. sfidNETHOOD = &H13 ' \nethood
    22. sfidFONTS = &H14 ' windows\fonts
    23. sfidTEMPLATES = &H15 ' Vorlagen
    24. sfidCOMMON_STARTMENU = &H16 ' All Users\StartMenu
    25. sfidCOMMON_PROGRAMS = &H17 ' AllUsers\Programs
    26. sfidCOMMON_STARTUP = &H18 ' AllUsers\Startup
    27. sfidCOMMON_DESKTOPDIRECTORY = &H19 ' AllUsers\Desktop
    28. sfidAPPDATA = &H1A ' name>\Application Data
    29. sfidPRINTHOOD = &H1B ' name>\PrintHood
    30. sfidLOCAL_APPDATA = &H1C ' name>\Local Settings\Applicaiton Data (non roaming)
    31. sfidALTSTARTUP = &H1D ' non localizedstartup
    32. sfidCOMMON_ALTSTARTUP = &H1E ' non localizedCommon startup
    33. sfidCOMMON_FAVORITES = &H1F
    34. sfidINTERNET_CACHE = &H20
    35. sfidCOOKIES = &H21
    36. sfidHISTORY = &H22
    37. sfidCOMMON_APPDATA = &H23 ' AllUsers\Application Data
    38. sfidWINDOWS = &H24 ' GetWindowsDirectory()
    39. sfidSYSTEM = &H25 ' GetSystemDirectory()
    40. sfidPROGRAM_FILES = &H26 ' C:\Program Files
    41. sfidMYPICTURES = &H27 ' C:\Program Files\My Pictures
    42. sfidPROFILE = &H28 ' USERPROFILE
    43. sfidSYSTEMX86 = &H29 ' x86 system directory on RISC
    44. sfidPROGRAM_FILESX86 = &H2A ' x86 C:\Program Files on RISC
    45. sfidPROGRAM_FILES_COMMON = &H2B ' C:\Program Files\Common
    46. sfidPROGRAM_FILES_COMMONX86 = &H2C ' x86 Program Files\Common on RISC
    47. sfidCOMMON_TEMPLATES = &H2D ' All Users\Templates
    48. sfidCOMMON_DOCUMENTS = &H2E ' All Users\Documents
    49. sfidCOMMON_ADMINTOOLS = &H2F ' All Users\Start Menu\Programs\Administrative Tools
    50. sfidADMINTOOLS = &H30 ' \Start Menu\Programs\Administrative Tools
    51. sfidProgramFiles = &H10000
    52. sfidCommonFiles = &H10001
    54. End Enum
    56. Private Type SHITEMID
    57. cb As Long
    58. abID As Byte
    59. End Type
    61. Private Type ITEMIDLIST
    62. mkid As SHITEMID
    63. End Type
    65. Private Declare Function GetUserName Lib "advapi32.dll" _
    66. Alias "GetUserNameA" (ByVal lpBuffer As String, _
    67. nSize As Long) As Long
    69. Private Declare Function GetTemppath Lib "kernel32.dll" Alias "GetTempPathA" _
    70. (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
    72. Private Declare Function SHGetSpecialFolderLocation Lib _
    73. "shell32.dll" (ByVal hwndOwner As Long, _
    74. ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
    76. Private Declare Function SHGetPathFromIDList Lib _
    77. "shell32.dll" Alias "SHGetPathFromIDListA" _
    78. (ByVal pidl As Long, ByVal pszPath As String) As Long
    80. ' Standard Systemordner ermitteln
    81. Public Function GetSpecialFolder(CSIDL As _
    82. SpecialFolderIDs) As String
    83. 'Aufrufbeispiel:
    84. 'sPathDesktop = GetSpecialFolder(sfidDESKTOP)
    86. Dim lResult As Long
    87. Dim IDL As ITEMIDLIST
    88. Dim sPath As String
    90. 10 On Error GoTo GetSpecialFolder_Error
    92. 20 lResult = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    93. 30 If lResult = 0 Then
    94. 40 sPath = Space$(512)
    95. 50 lResult = SHGetPathFromIDList(ByVal IDL.mkid.cb, _
    96. ByVal sPath)
    97. 60 GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
    98. 70 End If
    100. 80 On Error GoTo 0
    101. 90 Exit Function
    103. GetSpecialFolder_Error:
    105. 100 MsgBox "Fehlernr.: " & Err.Number & " (" & Err.Description & ") in Prozedur GetSpecialFolder von Modul GetSystemOrdner", , "Fehler in Zeile: " & Erl
    106. End Function
    108. Public Function GetTempFolder(Optional Unterverzeichnis As String)
    109. Dim retVal As Long
    110. Dim TempDir As String
    112. On Error GoTo GetTempFolder_Error
    115. 20 TempDir = Space$(260)
    116. 30 retVal = GetTemppath(Len(TempDir), TempDir)
    118. 40 If retVal <> 0 Then
    119. 50 GetTempFolder = Left$(TempDir, retVal) & Unterverzeichnis
    120. If PathExists(GetTempFolder) = False Then MkDir (GetTempFolder)
    121. 60 End If
    123. On Error GoTo 0
    124. Exit Function
    126. GetTempFolder_Error:
    128. MsgBox "Fehlernr. " & Err.Number & " (" & Err.Description & ") in Prozedur GetTempFolder von Modul GetSystemOrdner", , "Fehler in Zeile:" & Erl()
    129. End Function
    131. 'Die Prozedur ermittelt den angemeldeten
    132. 'Benutzernamen
    133. Public Function GetBenutzer() As String
    134. Dim UserName As String
    135. Dim Result As Long
    137. On Error GoTo GetBenutzer_Error
    139. 10 UserName = Space$(256)
    140. 20 Result = GetUserName(UserName, Len(UserName))
    142. 30 If InStr(UserName, Chr$(0)) > 0 Then _
    143. UserName = Left$(UserName, InStr(UserName, Chr$(0)) - 1)
    145. 40 GetBenutzer = UserName
    147. On Error GoTo 0
    148. Exit Function
    150. GetBenutzer_Error:
    152. MsgBox "Fehlernr. " & Err.Number & " (" & Err.Description & ") in Prozedur GetBenutzer von Modul GetSystemOrdner", , "Fehler in Zeile:" & Erl()
    153. End Function


    Aufruf wäre dann z. B.:

    ? GetSpecialFolder(sfidMyDocuments)
    \\DCFS01\RedirectedFolders\achilleus\Eigene Dateien


    Gruß Achilleus

    @petaod so hatte es leider nicht funktioniert. Es gab kein Debugfehler, aber es ist nicht im Ordner gelandet..
    Habe ich was falsch gemacht?

    Visual Basic-Quellcode

    1. [/url]Sub CopyRangeToJpeg()
    2. Dim aChart As Chart, rng As Range, Path As String
    3. myFileName = "#" & Sheets("MSB").Range("c2").Text & ".jpg"
    4. Path = ThisWorkbook.Path & "\" & myFileName
    6. Set rng = Sheets("MSB").Range("B1:g23")
    9. Call rng.CopyPicture(xlScreen, xlPicture)
    10. With Sheets.Add
    11. .Shapes.AddChart
    12. .Activate
    13. .Shapes.Item(1).Select
    14. Set aChart = ActiveChart
    15. .Shapes.Item(1).Line.Visible = msoFalse
    16. .Shapes.Item(1).Width = rng.Width
    17. .Shapes.Item(1).Height = rng.Height
    18. aChart.Paste
    19. aChart.Export Path
    21. Application.DisplayAlerts = False
    22. .Delete
    23. Application.DisplayAlerts = True
    24. End With
    25. MsgBox "Saved to " & vbCr & Path, vbInformation, ""
    26. End Sub[url='https://www.vb-paradise.de/index.php/Thread/136977-Pfad-von-der-Datei-vorgeben/#codeLine_4_f8d027']


    @-Franky- Eigentlich liegt die Datei im Sharepoint. Aber wenn man den Pfad ausliest, führt der Weg zu dem Ordner, der für alle zugänglich ist, über den Userordner...


    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „SZR2D“ ()

    SZR2D schrieb:

    Beim Path steht "https://..."

    Versuch's mal mit dem UNC-Pfad der URL oder mappe ein Netzlaufwerk auf die Sharepoint-URL
    stackoverflow.com/questions/36…excel-graph-to-sharepoint

    SZR2D schrieb:

    ein Befehl weiterhelfen, der ein Dialogfenster öffnet,

    FileDialog (mit der Option msoFileDialogFolderPicker): learn.microsoft.com/de-de/offi…el.application.filedialog
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „petaod“ ()

    Man kann Ordner vom Sharepoint mit OneDrive synchronisieren.

    Relative einfach über den lokalen Pfad zu Onedrive.

    Du sagst dies ist dein Pfad:

    Visual Basic-Quellcode

    1. ​ Path = "C:\Users\abs23zz\3M\Tier 1 Board LOK - MSB" & "\" & myFileName


    Was eigentlich dann gehen sollte ist:

    Visual Basic-Quellcode

    1. ​
    2. User = VBA.Environ("UserName")
    3. Path = "C:\Users\" & User &"\3M\Tier 1 Board LOK - MSB" & "\" & myFileName


    Ggf. musst man sich den Pfad zum Onedrive-Ordner geanuer anschauen.
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).

    Hallo Zusammen,
    jetzt hätte ich doch noch eine Frage..
    Bei allen Usern funktioniert der obige Vorschlag, aber bei einem Benutzer haben wir seltsamerweise ganz andere Ordnerstruktur und der kommt über einen anderen Pfad zu dem Ordner..
    So funktioniert es bei allen:

    Visual Basic-Quellcode

    1. Path = "C:\Users\" & User & "\3M\Tier 1 Board LOK - General\MSB" & "\" & myFileName

    Bei ihm nur über diesen Umweg:

    Visual Basic-Quellcode

    1. Path = "C:\Users\" & User & "\OneDrive - 3M\MSB" & "\" & myFileName


    Meine Frage dazu, wie kann man folgende Variable einbauen, dass beim Fehler, wenn der Pfad nicht gefunden wird ein Alternativpfad genommen wird, z.B. path2?

    Visual Basic-Quellcode

    1. ​Sub Screen()
    3. Dim strDateiname As String
    5. Dim aChart As Chart, rng As Range, Path As String
    6. User = VBA.Environ("UserName")
    7. myFileName = "#" & Sheets("MSB").Range("c2").Text & ".jpg"
    8. ' Path2 = "C:\Users\" & User & "\OneDrive - 3M\MSB" & "\" & myFileName
    9. Path = "C:\Users\" & User & "\3M\Tier 1 Board LOK - General\MSB" & "\" & myFileName
    10. Set rng = Sheets("MSB").Range("B1:g23")
    13. Call rng.CopyPicture(xlScreen, xlPicture)
    14. With Sheets.Add
    15. .Shapes.AddChart
    16. .Activate
    17. .Shapes.Item(1).Select
    18. Set aChart = ActiveChart
    19. .Shapes.Item(1).Line.Visible = msoFalse
    20. .Shapes.Item(1).Width = rng.Width
    21. .Shapes.Item(1).Height = rng.Height
    22. aChart.Paste
    24. aChart.Export Path
    26. Application.DisplayAlerts = False
    27. .Delete
    28. Application.DisplayAlerts = True
    29. End With
    30. MsgBox "Saved to " & vbCr & Path, vbInformation, ""
    31. End Sub

    Prüfe doch einfach ob der Ordner da ist oder nicht. Wenn nicht da dann den anderen Pfad.

    Zum Beispiel mit dieser Funktion:

    Visual Basic-Quellcode

    1. ​Public Function FolderExists(ByVal strFilePath As String) As Boolean
    2. FolderExists = False
    3. On Error Resume Next
    4. If Not Dir(strFilePath, vbDirectory) = vbNullString And Not strFilePath = vbNullString Then
    5. FolderExists = True
    6. End If
    7. End Function


    Alternativ kannst Du auch versuchen den OneDrive-Pfad aus der Registry auszulesen:
    RegKeyRead("HKEY_CURRENT_USER\Environment\OneDrive")
    RegKeyRead("HKEY_CURRENT_USER\Environment\OneDriveComerical")

    Visual Basic-Quellcode

    1. ​Function RegKeyRead(ByVal i_RegKey As String) As String
    2. ' taken from https://social.msdn.microsoft.com/Forums/office/en-US/1331519b-1dd1-4aa0-8f4f-0453e1647f57/how-to-get-physical-path-instead-of-url-onedrive?forum=officegeneral
    3. Dim myWS As Object
    5. On Error Resume Next
    6. 'access Windows scripting
    7. Set myWS = CreateObject("WScript.Shell")
    8. 'read key from registry
    9. RegKeyRead = myWS.RegRead(i_RegKey)
    10. End Function


    Ich denke OneDriveCommerical müsste der RegistryKey für Dich sein.
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).

    @INOPIAE Danke für deine Antwort, aber ich bin ein richtiger Noob und kann nicht ganz nachvollziehen, wie dein erstes Beispiel auf mein Code zugreift..
    Was du vorschlägst, wird ja in das Tabellenblatt kopiert, wenn ich es richtig verstehe, oder? Muss ich an meinem Code dann was ändern, damit die miteinander kommunizieren können?

    Mit registry fange ich lieber erst gar nicht an, weil ich da gar keine Ahnung habe.

    INOPIAE schrieb:

    Prüfe doch einfach ob der Ordner da ist oder nicht. Wenn nicht da dann den anderen Pfad.

    Zum Beispiel mit dieser Funktion:

    Visual Basic-Quellcode

    1. ​Public Function FolderExists(ByVal strFilePath As String) As Boolean
    2. FolderExists = False
    3. On Error Resume Next
    4. If Not Dir(strFilePath, vbDirectory) = vbNullString And Not strFilePath = vbNullString Then
    5. FolderExists = True
    6. End If
    7. End Function



    Waere das nicht einfacher fuer ein Anfaenger?

    VB.NET-Quellcode

    1. Imports.System.IO
    3. Friend Shared Function FolderExists(ByVal strDirPath As String) As Boolean
    4. If Not Directory.Exists(strDirPath) then return false
    5. End Function


    SZR2D schrieb:




    Bei ihm nur über diesen Umweg:

    Visual Basic-Quellcode

    1. Path = "C:\Users\" & User & "\OneDrive - 3M\MSB" & "\" & myFileName


    Meine Frage dazu, wie kann man folgende Variable einbauen, dass beim Fehler, wenn der Pfad nicht gefunden wird ein Alternativpfad genommen wird, z.B. path2?


    Das stinkt das fehlenden Umgebungsvariablen, check doch mal ob bei diesem User diese gegeben sind - sonst kannst du diese automatisiert eintragen. Oder es programmiertechnisch anders loesen...

    ATXMega256@32MHz schrieb:

    VB.NET-Quellcode
    Imports.System.IO
    Friend Shared Function FolderExists(ByVal strDirPath As String) As Boolean
    If Not Directory.Exists(strDirPath) then return false
    End Function

    Du weißt schon, dass wir hier VBA und nicht VB.Net brauchen?
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).

    @INOPIAE verstehe ich dich richtig, dass ich folgenden Code im Modul einfüge (mit beiden Pfaden):

    Visual Basic-Quellcode

    1. ​Sub Screen()
    2. Dim strDateiname As String
    3. Dim aChart As Chart, rng As Range, Path As String
    4. User = VBA.Environ("UserName")
    5. myFileName = "#" & Sheets("MSB").Range("c2").Text & ".jpg"
    7. Path = "C:\Users\" & User & "\OneDrive - 3M\General - Tier 1 Board LOK\MSB" & "\" & myFileName
    8. Path = "C:\Users\" & User & "\3M\Tier 1 Board LOK - General\MSB" & "\" & myFileName
    10. Set rng = Sheets("MSB").Range("B1:g23")
    11. Call rng.CopyPicture(xlScreen, xlPicture)
    12. With Sheets.Add
    13. .Shapes.AddChart
    14. .Activate
    15. .Shapes.Item(1).Select
    16. Set aChart = ActiveChart
    17. .Shapes.Item(1).Line.Visible = msoFalse
    18. .Shapes.Item(1).Width = rng.Width
    19. .Shapes.Item(1).Height = rng.Height
    20. aChart.Paste
    22. aChart.Export Path
    24. Application.DisplayAlerts = False
    25. .Delete
    26. Application.DisplayAlerts = True
    27. End With
    28. MsgBox "Saved to " & vbCr & Path, vbInformation, ""
    29. End Sub


    Dein Code wird dann im Tabellenblatt eingefügt und dann sollte es funktionieren?

    SZR2D schrieb:

    Path = "C:\Users\" & User & "\OneDrive - 3M\General - Tier 1 Board LOK\MSB" & "\" & myFileName
    Path = "C:\Users\" & User & "\3M\Tier 1 Board LOK - General\MSB" & "\" & myFileName


    Naja eigentlich eher so mit der von mir in Post 15 auf gezeigten Funktion FolderExists:

    Visual Basic-Quellcode

    1. IF FolderExists( "C:\Users\" & User & "\3M\Tier 1 Board LOK - General\MSB") = True Then
    2. Path = "C:\Users\" & User & "\3M\Tier 1 Board LOK - General\MSB" & "\" & myFileName
    3. Else
    4. Path = "C:\Users\" & User & "\OneDrive - 3M\General - Tier 1 Board LOK\MSB" & "\" & myFileName
    5. Endi If


    Schön Ausprogrammieren muss Du dann noch. ;)
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).

Facebook
Telefonspende