エクスプローラーからファイルを移動・コピーするには？
解決今、エクスプローラーからファイルリストボックスにマウスで
ドラッグ＆ドロップして移動・コピーを行いたいと考えているんですが
なかなかできません。
本やＨＰを見ても、「ファイル名の取得」としか書かれていません。
ファイルリストボックスからエクスプローラーにドラッグ＆ドロップして
移動・コピーは、なんとかできたのですが。
どなたか、分かる方、いらしゃいませんか。お願いします。
ファイルリストボックスにドロップされたパスが分からないと言う事ですか？
そうだったら
OLEDropMode プロパティを手動にして、
Private Sub File1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim objFile As Variant
For Each objFile In Data.Files
MsgBox objFile
Next
End Sub
こうやればパスが分かります。
あとはコピーでも移動でもお好きなように処理してください。
ＨＰみました。へー、福岡なんですか？私も、２年前まで３年間ほど
平尾に住んでいました。今まで住んだ土地の中で、一番好きなところです。
ヨイショじゃなくて。（大濠公園のベンチでゆっくりするのが好きでした）
ＶＢの掲示板でこんなこと書くのは叱られてしまうので本題に戻りますね。
この前の質問では、説明不足でしたので、補足させて下さい。
まず、DirListBoxとFileListBoxを貼り付け、FileListBoxから
ファイルを選択し、（例えば）デスクトップにドラッグすると、そこに
ファイルのコピー・移動ができるところまではできています。
ただ、その逆ができていないのです。つまり、（例えば）デスクトップから
FileListBoxにドラッグすると、ファイルのコピー・移動させたいのです。
OKUさんのパスの取得を試したのですが、パスが分かってもＶＢ初心者には
その先の処理が分かりません。とほほ…。:^^:
どうか、ご指導下さりますよう、お願いします。
'エクスプローラーにドラッグ＆ドロップ-----------------------------
Private Const vbDropEffectLink = 4
Private Sub File1_MouseMove(Button As Integer, Shift As Integer _
, X As Single, Y AsSingle)
If Button = vbLeftButton Then
File1.OLEDrag
File1.Refresh
End If
End Sub
Private Sub File1_OLEStartDrag(Data As DataObject _
, AllowedEffects As Long)
Dim i As Integer
Dim objFile As String
Data.Files.Clear
For i = 0 To File1.ListCount - 1
If File1.Selected(i) = True Then
If Right(Dir1, 1) = "\" Then
objFile = Dir1 & File1.List(i)
Else
objFile = Dir1 & "\" & File1.List(i)
End If
If Dir(objFile) <> vbNullString Then
'クリップボードに Files型のデータを作成
Data.SetData , vbCFFiles
Data.Files.Add objFile
End If
End If
Next
AllowedEffects = vbDropEffectCopy Or vbDropEffectMove _
Or vbDropEffectLink
End Sub
ファイルのコピー＆移動も分からなかったんですね。
>ファイルリストボックスからエクスプローラーにドラッグ＆ドロップして
>移動・コピーは、なんとかできたのですが。
と書いてあったので、ファイルのコピー＆移動は分かってると思いました。
さて、ファイルのコピー＆移動するにはいろいろやり方があります。
１ VBの機能を使う
２ ファイルシステムオブジェクトを使う
３ APIを使う
自分が知っているのは、こんなものです。
コーティングを以下に書きます。
１ VBの機能を使う
Private Sub File1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim objFile As Variant
For Each objFile In Data.Files
'コピーなら
FileCopy objFile, File1.Path & "\" & ファイル名
'移動なら
Name objFile As File1.Path & "\" & ファイル名
Next
End Sub
２ ファイルシステムオブジェクトを使う
Dim colFilesystem As Object
Dim strSrcName As String
Dim strDestName As String
Set colFilesystem = CreateObject("Scripting.FileSystemObject")
'コピーなら
colFilesystem.CopyFile objFile, File1.Path & "\" & ファイル名
'移動なら
colFilesystem.MoveFile objFile, File1.Path & "\" & ファイル名
' オブジェクトを解放
Set colFilesystem = Nothing
APIでのやり方は、ここのＡＰＩ 技術関連を参考にしてください
DirListBoxやFileListBoxは、使ったこと無いので
使い方間違ってたらすいません。
ヤマカサがあるけん博多タイ！
OKUさん、またまた返事ありがとうございます。
ご指導の元、ＡＰＩを使ってファイルの移動・コピーが
実現しました。ふー、なんとまー疲れました。ははっ。
でも、少し欲が出てしまい、なん点か教えていただきたいのですが
本当に何度もすみません。m+ +;m
１．FileListBox上で「Ctrl」を押してドロップしたときにコピーさせたい。
２．また「Ctrl」を押してる時に矢印と右下に「＋」プラスが付いたい
マウスポインターにしたい。
３．ドロップされた時に、フォルダとファイルを識別した。
いっぱいですみません。でも、ほんと分からなくて…。
'------------------------------------------------
API宣言「SHFileOperation」
Dim SHEF As SHFILEOPSTRUCT
If Right(Dir1, 1) = "\" Then
フォルダ = Dir1
Else
フォルダ = Dir1 & "\"
End If
For Each objFile In Data.Files
ファイル名 = Dir(objFile)
With SHEF
.hWnd = Me.hWnd
.wFunc = FO_MOVE '---------------Ａ
.pFrom = objFile
.pTo = フォルダ & ファイル名
.fFlags = FOF_ALLOWUNDO
End With
Ret = SHFileOperation(SHEF)
Next
File1.Refresh
「今年のどんたくは、連休のいつったい」ですか？
ちょっと表現ちがうかな ^_^;
うーーん少しはヘルプで調べてほしいですが、
福岡繋がりという事で、
まず
>１．FileListBox上で「Ctrl」を押してドロップしたときにコピーさせたい。
OLEDragDrop時にShift変数にCtrlが押されているか情報が
入っているのでそこを見てあげれば良いです。
Private Sub File1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Shift = vbCtrlMask Then
MsgBox "Ctrlキーを押したままドロップされました"
End If
End Sub
>２．また「Ctrl」を押してる時に矢印と右下に「＋」プラスが付いたい
> マウスポインターにしたい。
マウスポインタを矢印＆＋のポインタにしたいと言うことですか？
マウスポインタを変えることは出来ますが、
VBで用意されているポインタに希望のものが無いので、
どっかから入手してください。
入手したマウスポインタをFile1のMouseIcon プロパティに設定して
Ctrlキーが押されている時だけそのマウスポインタにしてやれば良いわけです。
Ctrlキーが話された時に標準のポインタに戻すのも忘れずに。
Private Sub File1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyControl Then
File1.MousePointer = vbCustom '99 ユーザー定義
End If
End Sub
Private Sub File1_KeyUp(KeyCode As Integer, Shift As Integer)
File1.MousePointer = vbDefault ' 0 規定値
End Sub
>３．ドロップされた時に、フォルダとファイルを識別した。
識別したいって事ですか？断言してるので違うのかな？
ちなみにこれもやり方いくつかあるんですが、
VB関数を使うなら Dir関数のヘルプを見てください。
自分はAPI使ってやってますけど。
Private Declare Function PathIsDirectory Lib "SHLWAPI.DLL" Alias "PathIsDirectoryA" _
(ByVal pszPath As String) As Long
'
' ディレクトリであるかどうか
'
Private Function IsDirectory(ByVal strFileName As String) As Boolean
' strFilename : チェックしたいディレクトリ名
' 戻り値 : ディレクトリであればTrueを返す。
Dim lngResult As Long
lngResult = PathIsDirectory(strFileName)
IsDirectory = Not (lngResult = 0)
End Function
Private Sub Command1_Click()
Dim strFileName As String
strFileName = "C:\WINNT\Profiles\Administrator\My Documents\HEROPA\TestCls\SHLWAPI"
Msgbox IsDirectory(strFileName)
End Sub
このAPIはInternet Explore 4.0以上がインストールされていないと
使えません。Win98以上ならデフォルトで入っているから問題ないでしょうが。
うーん これからは関数名やAPI名だけを教えるようにしようかな？
全部教えちゃうとその人の為にならないから。
んー、OKUさんはやさしいですね。
自分の思っているすべてのことが実現できました。
細かいところまで質問してしまったので、実は返事が返ってくるか
心配でした。確かに、全部教えてもらうと自分のためにならないことは
よく分かっています。ただ、ＨＰのOKUさんの顔を見たら、優しく教えてくれ
るかもしれないと思い、甘えが生じました。すみません。
これからは、ＰＯＩＮＴだけ質問するようにしますね。
ここ何日かお世話になりました。やっぱり、福岡は、いい人が多いったい。
福岡、バンザーイ！！
解決にチェックするのを忘れてました。どうも、すいません。
| ツイート |  |