趣味プログラミングblog

Sub カレントディレクトリを取得()
    Dim fPath As String
    fPath = "\\10.20.18.2\（樹脂の生産中止について） - ショートカット.lnk"

    Dim yPos As String: yPos = InStrRev(fPath, "\")
    Dim tPath As String: tPath = Left(fPath, yPos)
    Dim fName As String: fName = Mid(fPath, yPos + 1)
    Dim shPath As String: shPath = shortName(tPath)

    With CreateObject("WScript.Shell")
        Debug.Print .CreateShortcut(shortName(tPath) & "\" & fName)
    End With
End Sub

Function shortName(ByVal FileName As String)
'ショートネイム用のユーザー定義関数
  Dim objFS As Object
  Dim objFile As Object
  Set objFS = CreateObject("Scripting.FileSystemObject")
  If Right(FileName, 1) <> "\" Then  'フォルダーとファイルの区分け
    Set objFile = objFS.GetFile(FileName)
  Else
    Set objFile = objFS.GetFolder(FileName)
  End If
  shortName = objFile.shortPath
End Function

Function ファイルの存在チェックfso2(フルパス) As Long
    Dim flag As Long, objFile As Object
    With CreateObject("Scripting.FileSystemObject")
        Set objFile = .GetFile(フルパス)
            If .FileExists(objFile.shortPath) Then flag = 1
            ファイルの存在チェックfso2 = flag
        Set objFile = Nothing
    End With
End Function

Function ファイルの存在チェックfso(フルパス) As Long
    Dim flag As Long
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(フルパス) Then flag = 1
        ファイルの存在チェックfso = flag
    End With
End Function
Function ファイルの存在チェックdir(フルパス) As Long
    Dim flag As Long
    If Dir(フルパス) <> "" Then flag = 1
    ファイルの存在チェックdir = flag
End Function
Function ファイルの存在チェックhybrid(フルパス) As Long
    Dim flag As Long
    If Dir(フルパス) <> "" Then flag = 1
    If flag = 0 Then
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(フルパス) Then flag = 1
    End With
    End If
    ファイルの存在チェックhybrid = flag
End Function

Sub flagtest()
    On Error Resume Next
    Dim WSH, LnkFile, DeskTopPath As String, LnkFileName As String
    Set WSH = CreateObject("WScript.Shell")

    Dim Gyo As Long, GyoSt As Long, GyoEnd As Long
    GyoSt = 8
    GyoEnd = Cells(Rows.Count, "B").End(xlUp).Row

    Dim tictoc As Double:    tictoc = Timer
    Dim buf As Long

    For Gyo = GyoSt To GyoEnd
        DoEvents
        buf = buf + ファイルの存在チェックfso2(Cells(Gyo, "B"))
    Next Gyo

    Debug.Print "ファイルの存在チェックfso2", Timer - tictoc & "秒", buf
    tictoc = Timer
    buf = 0
    Stop
    For Gyo = GyoSt To GyoEnd
        DoEvents
        buf = buf + ファイルの存在チェックdir(Cells(Gyo, "B"))
    Next Gyo

    Debug.Print "ファイルの存在チェックdir", Timer - tictoc & "秒", buf
    tictoc = Timer
    buf = 0

    For Gyo = GyoSt To GyoEnd
        DoEvents
        buf = buf + ファイルの存在チェックfso(Cells(Gyo, "B"))
    Next Gyo

    Debug.Print "ファイルの存在チェックfso", Timer - tictoc & "秒", buf
    tictoc = Timer
    buf = 0

    For Gyo = GyoSt To GyoEnd
        DoEvents
        buf = buf + ファイルの存在チェックhybrid(Cells(Gyo, "B"))
    Next Gyo

    Debug.Print "ファイルの存在チェックhybrid", Timer - tictoc & "秒", buf
    tictoc = Timer
    buf = 0

    Set LnkFile = Nothing
    Set WSH = Nothing

End Sub