Excel VBA 例子

5. 在同一个模块里输入另外一个过程：
Sub GetFiles()
Dim nfile As String
Dim nextRow As Integer 'next row index
nextRow = 1
With Worksheets("Sheet1").Range("A1")
nfile = Dir("C:\", vbNormal)
.Value = nfile
Do While nfile <> ""
nfile = Dir
.Offset(nextRow, 0).Value = nfile
nextRow = nextRow + 1
Loop
End With
End Sub
过程GetFiles获取C盘根目录下的所有文件名并且将每个文件名写入工作表。

 

获得文件大小

Sub TotalBytesIni()
Dim iniFile As String
Dim allBytes As Long
iniFile = Dir("C:\WINDOWS\*.ini")
allBytes = 0
Do While iniFile <> ""
allBytes = allBytes + FileLen("C:\WINDOWS\" & iniFile)
iniFile = Dir
Loop
Debug.Print "Total bytes: " & allBytes
End Sub

 

获取文件属性

Sub GetAttributes()
Dim attr As Integer
Dim msg As String
attr = GetAttr("C:\MSDOS.SYS")
msg = ""
If attr AND vbReadOnly Then msg = msg & "Read-Only (R)"
If attr AND vbHidden Then msg = msg & Chr(10) & "Hidden (H)"
If attr AND vbSystem Then msg = msg & Chr(10) & "System (S)"
If attr AND vbArchive Then msg = msg & Chr(10) & "Archive (A)"
MsgBox msg, , "MSDOS.SYS"
End Sub

 

文件复制

Sub CopyToAbort()
Dim folder As String
Dim source As String
Dim dest As String
Dim msg1 As String
Dim msg2 As String
Dim p As Integer
Dim s As Integer
Dim i As Long
On Error GoTo ErrorHandler
folder = "C:\Abort"
msg1 = "The selected file is already in this folder."
msg2 = "was copied to"
p = 1
i = 1
' get the name of the file from the user 从用户处获取文件名称
source = Application.GetOpenFilename ‘Excel应用程序的方法GetOpenFilename从用户那里获取文件名称
' don’t do anything if cancelled 如果取消则不进行任何操作
If source = "False" Then Exit Sub

' get the total number of backslash characters "\" in the source 获取文件来源字符
串中的反斜杠数
' variable’s contents
Do Until p = 0
p = InStr(i, source, "\", 1)
If p = 0 Then Exit Do
s = p
i = p + 1
Loop
' create the destination file name 创建目的文件名称
dest = folder & Mid(source, s, Len(source))
' create a new folder with this name 创建同名文件夹
MkDir folder
' check if the specified file already exists in the 检查该文件是否在目的地已经存
在
' destination folder
If Dir(dest) <> "" Then
MsgBox msg1
Else
' copy the selected file to the C:\Abort folder 复制所选文件到文件夹“C:\Abort”
FileCopy source, dest
MsgBox source & " " & msg2 & " " & dest
End If
Exit Sub
ErrorHandler:
If Err = "75" Then
Resume Next
End If
If Err = "70" Then
MsgBox "You can’t copy an open file."
Exit Sub
End If
End Sub

删除文件

Sub RemoveMe()
Dim folder As String
Dim myFile As String
‘assign the name of folder to the folder variable
‘notice the ending backslash "\"
folder = "C:\Abort\"
myFile = Dir(folder, vbNormal)
Do While myFile <> ""
Kill folder & myFile
myFile = Dir
Loop
RmDir folder
End Sub

 

顺序读取文件

Sub ReadMe()
Dim rLine As String
Dim i As Integer ' line number
i = 1
Open "C:\Autoexec.bat" For Input As #1
' stay inside the loop until the end of file is reached
Do While Not EOF(1)
Line Input #1, rLine
MsgBox "Line " & i & " in Autoexec.bat reads: " _
& Chr(13) & Chr(13) & rLine
i = i + 1
Loop
MsgBox i & " lines were read."
Close #1
End Sub

顺序读取字符

Sub Colons()
Dim counter As Integer
Dim char As String
counter = 0
Open "C:\Autoexec.bat" For Input As #1
Do While Not EOF(1)
char = Input(1, #1)
If char = ":" Then
counter = counter + 1
End If
Loop
If counter <> 0 Then
MsgBox "Characters found: " & counter
Else
MsgBox "The specified character has not been found."
End If
Close #1
145
End Sub、

 

过程ReadAll将文件System.ini的内容读取到立即窗口里：
Sub ReadAll()
Dim all As String
Open "C:\WINNT\System.ini.bat" For Input As #1
all = Input(LOF(1), #1)
Debug.Print all
Close #1
End Sub

除了将文件内容打印到立即窗口之外，你还可以将其读取到一个文本框并且放置到工作表中去：
Sub WriteToTextBox()
Dim mysheet As Worksheet
Set mysheet = ActiveWorkbook.Worksheets(1)
On Error GoTo CloseFile
Open "C:\WINNT\System.ini" For Input As #1
mysheet.Shapes(1).Select
Selection.Characters.Text = Input(LOF(1), #1)
CloseFile:
Close #1
End Sub

 

Sub Winners()
Dim lname As String, fname As String, age As Integer
Open "C:\Winners.csv" For Input As #1
Do While Not EOF(1)
Input #1, lname, fname, age
MsgBox lname & ", " & fname & ", " & age
Loop
Close #1
End Sub

 

使用Write # 和Print # 语句

1. 在当前模块里输入过程DataEntry：
Sub DataEntry()
Dim lname As String
Dim fname As String
Dim birthdate As Date
Dim s As Integer
Open "C:\My Documents\Friends.txt" For Output As #1
lname = "Smith"
fname = "Gregory"
birthdate = #1/2/63#
s = 3
Write #1, lname, fname, birthdate, s
lname = "Conlin"
fname = "Janice"
birthdate = #5/12/48# s = 1
Write #1, lname, fname, birthdate, s
lname = "Kaufman"
fname = "Steven"
birthdate = #4/7/57#
s = 0
Write #1, lname, fname, birthdate, s
Close #1
End Sub
上面的过程打开文件C:\My Documents\Friends.txt来写入数据

 

Sub EnglishToSpanish()
Dim d As Dictionary
Dim RecNr As Long
Dim choice As String
Dim totalRec As Long
RecNr = 1
'open the file for random access 打开文件作随机访问
Open "Translate.txt" For Random As #1 Len = Len(d)
Do
' get the English word 活动英文词语
choice = InputBox("Enter an English word", "ENGLISH")
d.en = choice
' exit the loop if cancelled 如取消则退出循环
If choice = "" Then Exit Do
choice = InputBox("Enter the Spanish equivalent for " _
& d.en, "SPANISH EQUIVALENT " & d.en)
If choice = "" Then Exit Do
d.sp = choice
' write to the record 写入记录
Put #1, RecNr, d
' increase record counter 增加记录计数器
recNr = recNr + 1
Loop Until choice = "" 'ask for words until Cancel 询问词语直到取消
totalRec = LOF(1) / Len(d)
MsgBox "This file contains " & totalRec & " record(s)."
' close the file
Close #1
End Sub