随机剪切一个文件要怎么写

低调的奢华

指定目录
d:\temp
有n个文件*.xlsx，数量不确定。名称不确定。



宏运行一次，随机剪切一个文件到 e:\temp

要怎么写。

roserice

Sub ShowFolderList()
Dim arr(100)
    Dim fs, f, f1, i
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder("d:\temp").Files
     For Each f1 In f
   If Right(f1.Name, 4) = "xlsx" Then i = i + 1: arr(i) = f1.Name
  Next
    fs.movefile "d:\temp\" & arr(Int(i * Rnd)), "e:\temp"

End Sub

低调的奢华

roserice 发表于 2022-5-23 07:29
Sub ShowFolderList()
Dim arr(100)
    Dim fs, f, f1, i

    fs.movefile "d:\temp\" & arr(Int(i * Rnd)), "e:\temp"

这句错误，提示，拒绝的权限

roserice

低调的奢华 发表于 2022-5-23 11:36
fs.movefile "d:\temp\" & arr(Int(i * Rnd)), "e:\temp"

这句错误，提示，拒绝的权限

换个地方试试看

zjdh

少了一点点
fs.movefile "d:\temp\" & arr(Int(i * Rnd)+1), "e:\temp\"

roserice

zjdh 发表于 2022-5-23 13:48
少了一点点
fs.movefile "d:\temp\" & arr(Int(i * Rnd)+1), "e:\temp\"

谢谢回答,arr(Int(i * Rnd)+1)可以的

低调的奢华

zjdh 发表于 2022-5-23 13:48
少了一点点
fs.movefile "d:\temp\" & arr(Int(i * Rnd)+1), "e:\temp\"

改这句后，可以了。


但是延申出一个问题，，，因为是d:\temp   存在没有文件的时候，

就会提示出错，这个要怎么处理。

zjdh

低调的奢华 发表于 2022-5-23 18:49
改这句后，可以了。

Sub ShowFolderList()
    On Error GoTo 10
    Dim arr(100)
    Dim fs, f, f1, i
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder("d:\temp").Files
    For Each f1 In f
        If Right(f1.Name, 4) = "xlsx" Then i = i + 1: arr(i) = f1.Name
    Next
    fs.movefile "d:\temp\" & arr(Int(i * Rnd) + 1), "e:\temp\"
    Exit Sub
10    MsgBox " 请检查：d:\temp 中是否存在文件！"
End Sub