Private Sub Command2_Click()
FillInText("H:\") '假设H盘是U盘 '把U盘根目录下的所有文本文件读出,写到RichTextBox里
End Sub
Sub FillInText(ByVal Folder As String)
Dim fso As New FileSystemObject
Dim objFile, objFolder
Dim fLen As Long, fText As String
Set objFolder = fso.GetFolder(Folder)
For Each objFile In objFolder.Files
If fso.GetExtensionName(objFile.Path) = "txt" Then
fLen = FileLen(objFile.Path)
'多个文件的内容以星号隔开
RichTextBox1.Text = RichTextBox1.Text & "************************************************************************" & vbCrLf
fText = Space(fLen)
Open objFile.Path For Binary As #1 Len = fLen
Get 1, , fText
Close 1
RichTextBox1.Text = RichTextBox1.Text & fText
End If
Next
End Sub
检测磁盘:
Private Sub Command1_Click()
Dim ShellApp, oPanel, FolderItem1, FolderItem2, oItem
Set ShellApp = CreateObject("Shell.Application")
Set oPanel = ShellApp.NameSpace(0)
Set FolderItem2 = Nothing
For Each FolderItem1 In oPanel.Items
If FolderItem1.Name = "我的电脑" Then
Set FolderItem2 = FolderItem1.GetFolder: Exit For
End If
Debug.Print FolderItem1.Name
Next
If FolderItem2 Is Nothing Then
MsgBox "找不到项目!"
Exit Sub
End If
Set oItem = Nothing
For Each oItem In FolderItem2.Items
' Debug.Print oItem.Name
If InStr(oItem.Name, "可移动磁盘") Then
MsgBox "检测到" & oItem.Name
End If
Next
End Sub