言語・開発環境

  • VBScriptでクリップボードへコピー
    Public Sub PutInClipboardText(ByVal str)
      Dim cmd
      cmd = "cmd /c ""echo " & str & "| clip"""
      CreateObject("WScript.Shell").Run cmd, 0
    End Sub
  • 右クリックから出るポップアップメニューでファイルのフルパスを得るサンプル。(Windows7で最初の実行時には管理者権限が必要です)
    dim args
    dim toClip
    dim drive
    dim path
    
    On Error Resume Next
    
    If WScript.Arguments.Count = 0 Then
    
      Dim objWshShell
    
      Set objWshShell = WScript.CreateObject("WScript.Shell")
      If Err.Number = 0 Then
        objWshShell.RegRead("HKCR\Folder\shell\fullpathcopy\")
        If Err.Number = 0 Then
          objWshShell.RegDelete "HKCR\Folder\shell\fullpathcopy\command\"
          objWshShell.RegDelete "HKCR\Folder\shell\fullpathcopy\"
          objWshShell.RegDelete "HKCR\*\shell\fullpathcopy\command\"
          objWshShell.RegDelete "HKCR\*\shell\fullpathcopy\"
          WScript.Echo "右クリックメニューから削除しました。"
        Else
          Dim scriptPath
          scriptPath = "WScript.exe """ & WScript.ScriptFullName & """ ""%1"""
          objWshShell.RegWrite "HKCR\Folder\shell\fullpathcopy\", "フルパスをコピー(&F)", "REG_SZ"
          objWshShell.RegWrite "HKCR\Folder\shell\fullpathcopy\command\", scriptPath, "REG_SZ"
          objWshShell.RegWrite "HKCR\*\shell\fullpathcopy\", "フルパスをコピー(&F)", "REG_SZ"
          objWshShell.RegWrite "HKCR\*\shell\fullpathcopy\command\", scriptPath, "REG_SZ"
          WScript.Echo "右クリックメニューに登録しました。"
        End If
      Else
        WScript.Echo "エラー: " & Err.Description
      End If
    
      Set objWshShell = Nothing
    
    Else
    
      args = WScript.Arguments.Item(0)
      drive = Left(args, 2)
      path = Right(args, Len(args) - 2)
    
      drive = ChangeNetworkDrive(drive)
    
      toClip = drive & path
      ClipSet(toClip)
    
    End If
    
    On Error Goto 0
    
    
    Sub ClipSet(TextData)
      Dim FF
      Dim TB
      Set FF = CreateObject("Forms.Form.1")
      If IsEmpty(FF) Then
        Exit Sub
      End If
      Set TB = FF.Controls.Add("Forms.TextBox.1").Object
      TB.MultiLine = True
      TB.Text = TextData
      TB.SelStart = 0
      TB.SelLength = TB.TextLength
      TB.Copy
      Set TB = Nothing
      Set FF = Nothing
    End Sub
    
    
    Function ChangeNetworkDrive(src)
      Dim objWshNetwork   ' WshNetwork オブジェクト
      Dim objDrives       ' ドライブ情報
      Dim lngLoop         ' ループカウンタ
    
      Set objWshNetwork = WScript.CreateObject("WScript.Network")
      If Err.Number = 0 Then
        Set objDrives = objWshNetwork.EnumNetworkDrives
        If Err.Number = 0 Then
          If objDrives.Count > 0 Then
            For lngLoop = 0 To objDrives.Count - 1 Step 2
              If src = objDrives.Item(lngLoop) Then
                ChangeNetworkDrive = objDrives.Item(lngLoop + 1)
                Set objWshNetwork = Nothing
                Exit Function
              End If
            Next
          End If
        End If
      End If
    
      ChangeNetworkDrive = src
      Set objWshNetwork = Nothing
    End Function

トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2019-07-04 (木) 22:26:24 (671d)