VBA 选择文件
2015-09-06 11:24
387 查看
Private Function SelectFile(ByVal strFilter As String) As String
Dim
FileName As Variant
'打开文件对话框返回的文件名,是一个全路径文件名,其值也可能是False,因此类型为Variant
Dim sFileName As
String '从FileName中提取的文件名
Dim sPathName As
String '从FileName中提取的路径名
Dim aFile As
Variant '数组,提取文件名sFileName时使用
'调用Windows打开文件对话框
FileName = Application.GetOpenFilename(strFilter) '
"CSV 文件 (*.csv),*.csv"
If FileName = False
Then '如果按“取消”键
SelectFile = ""
Else
aFile = Split(FileName, "\")
'在全路径中,以“\”为分隔符,分成数据
sPathName = aFile(0)
'取盘符
For i = 1 To UBound(aFile) - 1
'循环合成路径名
sPathName = sPathName & "\" &
aFile(i)
Next
SelectFile = sPathName & "\" &
aFile(UBound(aFile))
End If
End Function
Sub test()
Dim txt As Object
Dim lRow As Long
Dim text As
String
Dim Filename As Variant
ChDir ThisWorkbook.Path
Filename =
Application.GetOpenFilename("Text Files (*.txt), *.txt", , "请选取档案", ,
MultiSelect:=True)
For Each fn In Filename
pge = pge + 1
lRow =
0
Set FSO = CreateObject("Scripting.FileSystemObject")
Set txt =
FSO.OpenTextFile(fn, ForReading, False)
Do Until
txt.AtEndOfStream
lRow = lRow + 1
text =
txt.ReadLine
ThisWorkbook.Worksheets(pge).Cells(lRow, 1) =
text
Loop
txt.Close
Set txt = Nothing
Next
End
Sub
Dim
FileName As Variant
'打开文件对话框返回的文件名,是一个全路径文件名,其值也可能是False,因此类型为Variant
Dim sFileName As
String '从FileName中提取的文件名
Dim sPathName As
String '从FileName中提取的路径名
Dim aFile As
Variant '数组,提取文件名sFileName时使用
'调用Windows打开文件对话框
FileName = Application.GetOpenFilename(strFilter) '
"CSV 文件 (*.csv),*.csv"
If FileName = False
Then '如果按“取消”键
SelectFile = ""
Else
aFile = Split(FileName, "\")
'在全路径中,以“\”为分隔符,分成数据
sPathName = aFile(0)
'取盘符
For i = 1 To UBound(aFile) - 1
'循环合成路径名
sPathName = sPathName & "\" &
aFile(i)
Next
SelectFile = sPathName & "\" &
aFile(UBound(aFile))
End If
End Function
Sub test()
Dim txt As Object
Dim lRow As Long
Dim text As
String
Dim Filename As Variant
ChDir ThisWorkbook.Path
Filename =
Application.GetOpenFilename("Text Files (*.txt), *.txt", , "请选取档案", ,
MultiSelect:=True)
For Each fn In Filename
pge = pge + 1
lRow =
0
Set FSO = CreateObject("Scripting.FileSystemObject")
Set txt =
FSO.OpenTextFile(fn, ForReading, False)
Do Until
txt.AtEndOfStream
lRow = lRow + 1
text =
txt.ReadLine
ThisWorkbook.Worksheets(pge).Cells(lRow, 1) =
text
Loop
txt.Close
Set txt = Nothing
Next
End
Sub