Cum sa faci un folder calea universală?

Question 1

Noi să VBA și au o misiune de a crea un sub care paste de la un registru de lucru într-un registru de lucru nou. O cerință pentru salvarea fișierului este că "calea de folder fi universal, astfel încât alte persoane pot crea acest folder prea". Ce modificare as face la ActiveWorkbook.SaveAs metoda pentru a îndeplini acest lucru? Multumesc

Sub pasteTable()

    Dim formatting As Variant 'create variable to hold formatting2 workbook path
    formatting = Application.GetOpenFilename()  'user is prompted and selects path to formatting2 workbook and assigns to formatting variable
    
    Workbooks.Open formatting  'formatting2 workbook is now active
    Worksheets("Formatting").Range("B3:R13").Copy  'copies table from formatting2 workbook
    Workbooks.Add  'add new workbook
    
    Worksheets(1).Range("B3:R13").Select  'selects range on worksheet of new workbook to paste table
    Selection.PasteSpecial xlPasteAll 'pastes table
    
    Columns("B:R").ColumnWidth = 20  'ensures table has proper row and column heights/widths
    Rows("3:13").RowHeight = 25
    
    Worksheets(1).Name = "Table Data"  'renames worksheet
        
    ActiveWorkbook.SaveAs "C:\Users\name\Desktop\names Excel Assessment VBA\names Excel Assessment VBA " & Format(Date, "dd/mmm/yyyy"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
    'saves workbook according to desired specifications
End Sub

Question 2

Schimba-ti Salva linia asta:

ActiveWorkbook.SaveAs "C:\Users\" & Environ("Username") & "\Desktop\Excel Assessment VBA\Excel Assessment VBA " & Format(Date, "dd-mmm-yyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

La Username variabila de sistem va ajusta în funcție de contul de utilizator Windows care este în uz. Doar asigurați-vă că fiecare utilizator are acele foldere existente pe desktop-ul lor, sau veți obține o eroare. Am eliminat, de asemenea, names din folderul nume ca presupun că ai încercat să faci ceva cu numele de utilizator și acolo. Puteți ajusta că la nevoile tale.

Formatul Datei este necesar să se schimbe așa cum a fost, inclusiv caractere ilegale.

Ai, de asemenea, a uitat să includă o extensie de fișier, așa că am adăugat că la fel de bine.

Există o mulțime întâmplă cu acea linie, inclusiv o mulțime de greșeli, așa că aveți de gând să aibă să se joace cu ea un pic până când veți obține exact ceea ce ai nevoie. Poate doriți pentru a simplifica un pic până când veți obține atarna de toate aceste lucruri.

Question 3

Cred că trebuie să adăugați ceva mai mult control

Script-ul se așteaptă ca numele de instrument-calea-folder ca constanta ToolFolder.

Plus o a doua constantă ToolBaseFolder care ar putea fi stabilit la mamă-calea `ToolFolder, de exemplu, o cale de rețea. Daca const este gol, utilizatorii de desktop va fi folosit.

Dacă această cale nu există încă, acesta va fi creat.

Option Explicit

Private Const ToolBaseFolder As String = "" 'if ToolBaseFolder is an empty string desktop will be used instead
Private Const ToolFolder As String = "MyNameForToolFolder"


Public Sub testWbToToolFolder()
'this is just for testing
Dim wb As Workbook: Set wb = ActiveWorkbook
saveWbToToolFolder wb, "test.xlsx"
End Sub


Public Sub saveWbToToolFolder(wb As Workbook, filename As String)
'you don't need this sub - but have the same code line in your main routine
wb.SaveAs getToolFolder & filename
End Sub



Public Function getToolFolder() As String
'this returns the toolfolder e.g. C:\Users\xyz\Desktop\MyNameForToolFolder

Dim basepath As String
basepath = ToolBaseFolder & "\"

If existsFolder(basepath) = False Then
    If LenB(ToolBaseFolder) > 0 Then
        MsgBox ToolBaseFolder & " does not exist." & vbCrLf & _
            "File will be saved to " & ToolFolder & " on desktop ", vbExclamation
    End If
    basepath = getDesktopFolderOfUser
End If

Dim fullpath As String
fullpath = basepath & ToolFolder & "\"

If existsFolder(fullpath) = False Then
    makeFolder fullpath
End If

getToolFolder = fullpath

End Function


Private Function existsFolder(path As String) As Boolean
If Len(path) < 2 Then Exit Function 'can't be a valid folder
existsFolder = LenB(Dir(path, vbDirectory)) > 0
End Function

Private Function getDesktopFolderOfUser() As String
getDesktopFolderOfUser = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
End Function

Private Function makeFolder(path As String)
'https://stackoverflow.com/a/26934834/16578424 plus comment from rayzinnz
CreateObject("WScript.Shell").Run "cmd /c mkdir """ & path & """", 0, True
End Function

braX · Answer 1 · 2021-11-24T06:52:45

Schimba-ti Salva linia asta:

ActiveWorkbook.SaveAs "C:\Users\" & Environ("Username") & "\Desktop\Excel Assessment VBA\Excel Assessment VBA " & Format(Date, "dd-mmm-yyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

La Username variabila de sistem va ajusta în funcție de contul de utilizator Windows care este în uz. Doar asigurați-vă că fiecare utilizator are acele foldere existente pe desktop-ul lor, sau veți obține o eroare. Am eliminat, de asemenea, names din folderul nume ca presupun că ai încercat să faci ceva cu numele de utilizator și acolo. Puteți ajusta că la nevoile tale.

Formatul Datei este necesar să se schimbe așa cum a fost, inclusiv caractere ilegale.

Ai, de asemenea, a uitat să includă o extensie de fișier, așa că am adăugat că la fel de bine.

Există o mulțime întâmplă cu acea linie, inclusiv o mulțime de greșeli, așa că aveți de gând să aibă să se joace cu ea un pic până când veți obține exact ceea ce ai nevoie. Poate doriți pentru a simplifica un pic până când veți obține atarna de toate aceste lucruri.

Ike · Answer 2 · 2021-11-24T04:46:46

Cred că trebuie să adăugați ceva mai mult control

Script-ul se așteaptă ca numele de instrument-calea-folder ca constanta ToolFolder.

Plus o a doua constantă ToolBaseFolder care ar putea fi stabilit la mamă-calea `ToolFolder, de exemplu, o cale de rețea. Daca const este gol, utilizatorii de desktop va fi folosit.

Dacă această cale nu există încă, acesta va fi creat.

Option Explicit

Private Const ToolBaseFolder As String = "" 'if ToolBaseFolder is an empty string desktop will be used instead
Private Const ToolFolder As String = "MyNameForToolFolder"


Public Sub testWbToToolFolder()
'this is just for testing
Dim wb As Workbook: Set wb = ActiveWorkbook
saveWbToToolFolder wb, "test.xlsx"
End Sub


Public Sub saveWbToToolFolder(wb As Workbook, filename As String)
'you don't need this sub - but have the same code line in your main routine
wb.SaveAs getToolFolder & filename
End Sub



Public Function getToolFolder() As String
'this returns the toolfolder e.g. C:\Users\xyz\Desktop\MyNameForToolFolder

Dim basepath As String
basepath = ToolBaseFolder & "\"

If existsFolder(basepath) = False Then
    If LenB(ToolBaseFolder) > 0 Then
        MsgBox ToolBaseFolder & " does not exist." & vbCrLf & _
            "File will be saved to " & ToolFolder & " on desktop ", vbExclamation
    End If
    basepath = getDesktopFolderOfUser
End If

Dim fullpath As String
fullpath = basepath & ToolFolder & "\"

If existsFolder(fullpath) = False Then
    makeFolder fullpath
End If

getToolFolder = fullpath

End Function


Private Function existsFolder(path As String) As Boolean
If Len(path) < 2 Then Exit Function 'can't be a valid folder
existsFolder = LenB(Dir(path, vbDirectory)) > 0
End Function

Private Function getDesktopFolderOfUser() As String
getDesktopFolderOfUser = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
End Function

Private Function makeFolder(path As String)
'https://stackoverflow.com/a/26934834/16578424 plus comment from rayzinnz
CreateObject("WScript.Shell").Run "cmd /c mkdir """ & path & """", 0, True
End Function

Cum sa faci un folder calea universală?

Problema

În alte limbi

Această pagină este în alte limbi

Popular în această categorie

Întrebări frecvente în această categorie