Klasör yolu evrensel nasıl yapılır?

Question 1

VBA'DA yenidir ve bir çalışma kitabından yeni bir çalışma kitabına yapışan bir alt oluşturmak için bir ödeviniz vardır. Dosyayı kaydetmek için bir gereksinim, "klasör yolunun evrensel olması, böylece diğer kişilerin de bu klasörü oluşturabilmesidir". Activeworkbook'ta ne gibi bir değişiklik yapardım.Bunu gerçekleştirmek için SaveAs yöntemi? Teşekkürler

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

Kaydetme satırınızı buna değiştirin:

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

Bu Username sistem değişkeni, kullanılan Windows hesabına bağlı olarak ayarlanır. Her kullanıcının masaüstünde de bu klasörlerin bulunduğundan emin olun, aksi takdirde bir hata alırsınız. Ben de kaldırdım names klasör adlarından, kullanıcı adıyla da bir şeyler yapmaya çalıştığınızı varsayıyorum. Bunu ihtiyaçlarınıza göre ayarlayabilirsiniz.

Tarih biçiminizin de yasa dışı karakterler içerdiğinden değişmesi gerekiyordu.

Ayrıca bir dosya uzantısı eklemeyi unuttun, ben de ekledim.

Bu çizgide çok fazla hata da dahil olmak üzere çok şey oluyor, bu yüzden tam olarak ihtiyacınız olanı elde edene kadar onunla biraz oynamak zorunda kalacaksınız. Tüm bu şeyleri öğrenene kadar biraz basitleştirmek isteyebilirsiniz.

Question 3

Sanırım biraz daha çek eklemelisin.

Senaryoyu sürekli olarak aracın adı-yol-klasör bekliyor ToolFolder.

Artı ikinci bir sabit ToolBaseFolder bu, üst yol `araç klasörüne, örneğin bir ağ yoluna ayarlanabilir. Const boşsa, kullanıcılar masaüstü kullanılacaktır.

Bu yol henüz mevcut değilse, oluşturulacaktır.

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

Kaydetme satırınızı buna değiştirin:

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

Bu Username sistem değişkeni, kullanılan Windows hesabına bağlı olarak ayarlanır. Her kullanıcının masaüstünde de bu klasörlerin bulunduğundan emin olun, aksi takdirde bir hata alırsınız. Ben de kaldırdım names klasör adlarından, kullanıcı adıyla da bir şeyler yapmaya çalıştığınızı varsayıyorum. Bunu ihtiyaçlarınıza göre ayarlayabilirsiniz.

Tarih biçiminizin de yasa dışı karakterler içerdiğinden değişmesi gerekiyordu.

Ayrıca bir dosya uzantısı eklemeyi unuttun, ben de ekledim.

Bu çizgide çok fazla hata da dahil olmak üzere çok şey oluyor, bu yüzden tam olarak ihtiyacınız olanı elde edene kadar onunla biraz oynamak zorunda kalacaksınız. Tüm bu şeyleri öğrenene kadar biraz basitleştirmek isteyebilirsiniz.

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

Sanırım biraz daha çek eklemelisin.

Senaryoyu sürekli olarak aracın adı-yol-klasör bekliyor ToolFolder.

Artı ikinci bir sabit ToolBaseFolder bu, üst yol `araç klasörüne, örneğin bir ağ yoluna ayarlanabilir. Const boşsa, kullanıcılar masaüstü kullanılacaktır.

Bu yol henüz mevcut değilse, oluşturulacaktır.

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

Klasör yolu evrensel nasıl yapılır?

Soru

Diğer dillerde

Bu sayfa diğer dillerde

Bu kategoride popüler

Popüler soruları bu kategoride