使用 vba 在网络驱动器中创建文件夹

Question

我需要连接到一个网络驱动器并创建一个文件夹。 我不知道驱动器的IP。 我也不想使用驱动器号，因为这个 VBA 将被许多人在他们的 PC 上使用。

我试过这个：

Public Function create_folder()
 Dim NetworkObject As Object
    Dim FSO As Object
    Dim Directory As Object
    Dim Filename As Object
    Dim ServerShare As String
 ServerShare = "\\SSSXCXC\FOL_SAS\ASD123\"

Set NetworkObject = CreateObject("WScript.Network")
Set FSO = CreateObject("Scripting.FileSystemObject")
NetworkObject.MapNetworkDrive "", ServerShare, False
 Set Directory = FSO.CreateFolder(ServerShare & "\AAA")
End Function

但是我收到路径错误。

Answer 1

我想你不需要在 map 的网络驱动器上创建文件夹。 如果您具有写入权限，则应创建该文件夹。

Const SERVER_PATH As String = "\\SSSXCXC\FOL_SAS\ASD123\"

Dim folderPath As String
folderPath = SERVER_PATH & "AAA"

With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(folderPath) Then .CreateFolder folderPath 
End With

Answer 2

Function GetNetworkPath(ByVal DriveName As String) As String
    Dim objNtWork  As Object
    Dim objDrives  As Object
    Dim lngLoop    As Long

    Set objNtWork = CreateObject("WScript.Network")
    Set objDrives = objNtWork.enumnetworkdrives

    For lngLoop = 0 To objDrives.Count - 1 Step 2
        If UCase(objDrives.Item(lngLoop)) = UCase(DriveName) Then
            GetNetworkPath = objDrives.Item(lngLoop + 1)
            Exit For
        End If
    Next
End Function

Answer 3

我有一个类似的问题，我会解释，底部有一个可行的解决方案（可以写入 .network 但不能复制）。

我想在.network 上复制一个文件夹并重命名。 这是一个包含我们用作模板的子文件夹嵌套的文件夹。

看起来它应该在 Locals window 中工作，但没有创建该文件夹。

我认为这是 a.network 权利问题

Sub CreateMajorResponseFile()
'creates a response folder with the app number as folder name

'declare road name as a variable
Dim Road As String
Dim AppNo As String
Dim Prefix As String
Dim FolderPath As String
Dim tbl As ListObject
Dim LastRow As Long
'enable code to use Scripting.FileSytemObject so it's easy to copy and rename a folder pt1
Dim FSO As Object
'pt2 of enable code to use Scripting.FileSytemObject so it's easy to copy and rename a folder
Set FSO = CreateObject("Scripting.FileSystemObject")

Dim SourceFolder As String
Dim DestinationFolder As String

'set the folder you want to copy
SourceFolder = "S:my source folder"
'set the file path for the folder you want to copy to
DestinationFolder = "S:\my destination folder" & Road

'set the road variable to be 4 rows right of selected cell
Road = ActiveCell.Offset(0, 4).value

'set the AppNo the selected cell
AppNo = ActiveCell.value
AppNo = Left(AppNo, 6) & "-" & Right(AppNo, 5)

Prefix = Application.InputBox("Enter N followed by EITHER property number OR short name", "Give it a prefix", "N")


''create folder with file path to the road name folder
'MkDir "S:\my network path" & "\" & Road & "\" & Prefix & " " & AppNo & Suffix

FSO.CopyFolder Source:=SourceFolder, Destination:=DestinationFolder & "\" & Prefix & " " & AppNo


End Sub

但是我有另一段代码可以在不使用文件系统对象的情况下在 .network 上创建一个新文件夹。 这是代码

Sub CreateResponseFile()
'creates a response folder with the app number as folder name

'declare road name as a variable
Dim Road As String
Dim AppNo As String
Dim Prefix As String
Dim Suffix As String
Dim FolderPath As String



'set the road variable to be 4 rows right of selected cell
Road = ActiveCell.Offset(0, 4).value

'set the AppNo the selected cell
AppNo = ActiveCell.value
AppNo = Left(AppNo, 6) & "-" & Right(AppNo, 5)

Prefix = Application.InputBox("Enter N followed by EITHER property number OR short name", "Give it a prefix", "N")

Suffix = Application.InputBox("Enter a space followed by e.g. C16 cycl parking or CEMP etc, if full app leave blank", "Give it a suffix", " C99EVCP")

'create folder with file path to the road name folder
MkDir "S:\my network path" & "\" & Road & "\" & Prefix & " " & AppNo & Suffix


End Sub

所以看起来 MkDir 可以在 FSO 复制不能的 a.network 上工作