Excel中用VBA弹出对话框选择文件(浏览效果)
'选择文件
Function file()
'定义变量
dim strFileFullName As String
'调用文件打开对话框
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False '只能选单一文件(False只允许选单个文件,True可选多文件)
'多文件选择可通过数组变量保存返回值,并用循环语句读出文件路径和文件名(此不举例,只给出单一选择的例子,如有需要,请看对话框的帮助文件)
.InitialFileName = ThisWorkbook.path '设置默认路径
.Filters.Add "文本文件", "*.xls" '限制文件类型
.title = "请选择文件" '设置打开对话框的标题
.Show
strFileFullName = .SelectedItems(1) '将选中的文件路径赋值给变量
'MsgBox "你选择的文件路径为:" & strFileFullName _
' & vbCr & "文件名为:" & Dir(strFileFullName) '屏幕显示变量值
End With
file = strFileFullName
End Function
从excel1文件中复制数据到excel2文件中
方法一:像提取数据库那样用sql提取
Set conn = CreateObject("adodb.connection") ‘设置新连接
conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " + path(路径) + title(文件名) + ".xls" ‘打开文件,不同文件open的provider和extended properties不一样
Worksheets.Add after:=Sheets(Sheets.Count) ‘给目标excel2增加sheet
ActiveSheet.Name = title ‘给新增的sheet命名
countSql = "select count(*) from [SQL Results$] where 条件语句" ‘SQL Results为要提取的excel1的sheet名
Set count = conn.Execute(countSql) ‘执行sql
If count.fields(0).Value > 0 Then ‘count.fields(0).Value即第一行数据的第一个值(此处我只用于查找出了数据即不为空)
Sql = "select * from [SQL Results$] where条件语句"
Sheets(title).Range("A3").CopyFromRecordset conn.Execute(Sql) ‘将执行的sql查到的数据copy到此excel(这里是excel2)中的以title为sheet名的A3处开始复制
End If
' rst=conn.Execute(Sql)
' Do While Not rst.EOF
' xxx = rst.fields(0).Value '执行sql取值,直至取到最后一个值
' rst.movenext
' Loop
conn.Close ‘关闭文件
Set conn = Nothing ‘连接设为空
该方法复制速度快,对数据格式无要求的可以应用此方法
方法二:直接从excel1中复制粘贴到excel2中(包括excel1中数据的格式)
Set mybook = GetObject(path) ‘打开excel1文件,path为文件路径,如:C:\excel1.xls
With mybook.Sheets(title)
.Activate ‘将excel1中名为title的sheet激活
.Range(.Cells(1, 1), .Cells(2, i)).Select ‘将需要复制的内容选中
Selection.copy ‘复制
End With
ThisWorkbook.Sheets(title).Activate ‘将此excel(即excel2)中名为title的sheet激活
Range("c1").Select ‘将c1作为开始选择
ActiveSheet.Paste ‘粘贴