2

最初は私だけが使用したこのマクロがあります。しかし、私は今それを他の人に配布する必要があります。基本的に、ファイルを参照できるマクロを作成し、ローカル パスをネットワーク ドライブ パス (HTML スタイル) に変換します。以下のコードからわかるように、特に R ドライブと Z ドライブについて言及しています。ただし、他の人が使用する場合は、代わりに A ドライブと B ドライブを使用できます。ローカル ドライブの代わりにネットワーク ドライブをプルするように、次のように書き直すにはどうすればよいですか? ありがとう！

Private Sub GetFilePath_Click()

FilePath = Application.GetOpenFilename()
If FilePath <> False Then
    Range("E6").Value = FilePath
End If

End Sub

選択したファイルをHTMLパスに変換する機能

Function ModFilePath(FilePath As String) As String

Dim HTMLFilePath As String
Dim Drive1 As String
Dim Drive2 As String
Dim Drive3 As String

On Error Resume Next

HTMLFilePath = Replace(FilePath, " ", "%20")

'I know somehow I need to rewrite this part
Drive1 = Replace(HTMLFilePath, "R:\", "\\network_name\apple\")
Drive2 = Replace(HTMLFilePath, "Z:\", "\\network_name\orange\")

If Err.Number = 0 Then
    If Left(HTMLFilePath, 1) = "R" Then
        ModFilePath = Drive1
    Else
        If Left(HTMLFilePath, 1) = "Z" Then
            ModFilePath = Drive2
        End If
    End If

Else
    ModFilePath = "Error"
End If

End Function
4

3 に答える 3

0

個人的には、入力ボックスを追加して、ユーザーがドライブを入力し、与えられた値をパスの残りの部分と連結できるようにします。

于 2013-08-09T10:21:11.373 に答える
0

いくつかの調査を行った後、実際に自分の質問に答えました。興味のある方はこちらのコードをどうぞ。次のコードは、エンド ユーザーがファイルをインポートするときに、ネットワーク共有ドライブ文字の代わりに UNC パスを取得します。

Option Explicit

Private Declare Function SetCurrentDirectory _
Lib "kernel32" _
Alias "SetCurrentDirectoryA" ( _
ByVal lpPathName As String) _
As Long

Public Sub GetFilePath_Click()
Dim vFileToOpen As Variant
Dim strCurDir As String
Dim WikiName As String

'// Keep Original Dir
strCurDir = CurDir

'// Note: If the UNC path does not exist then
'// It will default to your current one
SetCurrentDirectory "\\network_name\"
vFileToOpen = Application.GetOpenFilename
If TypeName(vFileToOpen) <> "Boolean" Then
    Range("E6").Value = vFileToOpen
End If


'// End by resetting to last/original Dir
ChDir strCurDir

End Sub

以下の関数は、インポートされたファイルのファイル パスを HTML スタイルに変換します。

Function Path2UNC(sFullName As String) As String
    ' Converts the mapped drive path in sFullName to a UNC path if one exists.
    ' If not, returns a null string

    Dim sDrive      As String
    Dim i           As Long
    Dim ModDrive1 As String

    Application.Volatile

    sDrive = UCase(Left(sFullName, 2))

    With CreateObject("WScript.Network").EnumNetworkDrives
        For i = 0 To .Count - 1 Step 2
            If .Item(i) = sDrive Then
                Path2UNC = .Item(i + 1) & Mid(sFullName, 3)
                Exit For
             End If
        Next
     End With

     ModDrive1 = Replace(Path2UNC, " ", "%20")
     Path2UNC = ModDrive1

 End Function
于 2013-08-12T15:50:38.360 に答える
0

http://support.microsoft.com/kb/160529からコピー

Microsoft Office 97 および Microsoft Office 7.0

   ' 32-bit Function version.
   ' Enter this declaration on a single line.
   Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias _
      "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal _
      lpszRemoteName As String, lSize As Long) As Long

   ' 32-bit declarations:
   Dim lpszRemoteName As String
   Dim lSize As Long

   ' Use for the return value of WNetGetConnection() API.
   Const NO_ERROR As Long = 0

   ' The size used for the string buffer. Adjust this if you
   ' need a larger buffer.
   Const lBUFFER_SIZE As Long = 255

   Sub GetNetPath()

      ' Prompt the user to type the mapped drive letter.
      DriveLetter = UCase(InputBox("Enter Drive Letter of Your Network" & _
         "Connection." & Chr(10) & "i.e. F (do not enter a colon)"))

      ' Add a colon to the drive letter entered.
      DriveLetter = DriveLetter & ":"

      ' Specifies the size in characters of the buffer.
      cbRemoteName = lBUFFER_SIZE

      ' Prepare a string variable by padding spaces.
      lpszRemoteName = lpszRemoteName & Space(lBUFFER_SIZE)

      ' Return the UNC path (\\Server\Share).
      lStatus& = WNetGetConnection32(DriveLetter, lpszRemoteName, _
         cbRemoteName)

      ' Verify that the WNetGetConnection() succeeded. WNetGetConnection()
      ' returns 0 (NO_ERROR) if it successfully retrieves the UNC path.
      If lStatus& = NO_ERROR Then

         ' Display the UNC path.
          MsgBox lpszRemoteName, vbInformation

      Else
         ' Unable to obtain the UNC path.
         MsgBox "Unable to obtain the UNC path.", vbInformation
      End If

   End Sub

マイクロソフト エクセル 5.0

   ' 16-bit Function for Excel 5.0.    ' Enter this declaration on a single line.    Declare Function WNetGetConnection Lib "user" (ByVal lpszLocalName _
      As String, ByVal lpszRemoteName As String, cbRemoteName As _
      Integer) As Integer

   ' 16-bit declarations:    Dim NetName As String    Dim x As Integer Dim DriveLetter As String

   Sub GetNetPath()

      ' Prompt the user to type the mapped drive letter.
      DriveLetter = UCase(InputBox("Enter Drive Letter of Your Network" & _
         "Connection." & Chr(10) & "i.e. F (do not enter a colon)"))

      DriveLetter = DriveLetter & ":"

      ' 16-bit call for Excel 5.0.
      ' Pad NetName with spaces.
      NetName = NetName & Space(80)

      ' API call returns one of eight values. If it returns zero, it is
      ' successful.
      x = WNetGetConnection(DriveLetter, NetName, 80)

      ' Display the UNC path.
      MsgBox NetName

   End Sub
于 2014-04-01T14:42:36.007 に答える