VBA_路径动态选择

lcxq120713

Sub 取数据()
Dim str As String
Dim wb As Workbook
Dim i, j As Integer
Excel.Application.DisplayAlerts = False
Excel.Application.ScreenUpdating = False
Sheet1.Range("A3:AO5000").ClearContents
str = Dir("D:\源文件\*.xls*")
For i = 1 To 100
    Set wb = Workbooks.Open("D:\源文件\" & str)
    i = wb.Sheets(1).Range("A5000").End(xlUp).Row
    j = ThisWorkbook.Sheets("数据").Range("A5000").End(xlUp).Row
    wb.Sheets(1).Range("A3:AO" & i).Copy ThisWorkbook.Sheets("数据").Range("a" & j + 1)
    wb.Close
    str = Dir
    If str = "" Then
        Exit For
    End If
Next
Excel.Application.DisplayAlerts = True
Excel.Application.ScreenUpdating = True
End Sub


怎么实现路径动态选择?谢谢老师

lcxq120713

动态选择文件夹

WANT-T

'选择文件

1. <blockquote>Public Function getFile() As String

复制代码

‘选择文件夹

1. Public Function GetFolder() As String
   
2.     With Application.FileDialog(msoFileDialogFolderPicker)
   
3.         If .Show Then
   
4.             GetFolder = .SelectedItems(1)
   
5.         Else
   
6.             GetFolder = ""
   
7.         End If
   
8.     End With
   
9. End Function

复制代码

ykcbf1100

1. With Application.FileDialog(msoFileDialogFolderPicker)
   
2.         .Title = "请选择文件夹"
   
3.         .InitialFileName = ThisWorkbook.path & ""
   
4.         If .Show = -1 Then        
   
5.             p = .SelectedItems(1) & ""
   
6.         End If
   
7.     End With

复制代码

动态选择文件夹。

tanglf188

单选文件夹

1.     With Application.FileDialog(msoFileDialogFolderPicker)
   
2.         .Title = "请选择文件夹"  '设置对话框标题
   
3.         .ButtonName = "确定选择"  '更换确定按钮名称
   
4.         .InitialFileName = ThisWorkbook.Path & ""  '设置初始文件夹名:打开对话框时，选定的文件夹名(可含路径，能用通配符)
   
5.         .Filters.Clear  '清除文件过滤器
   
6.         If .Show = -1 Then 'FileDialog对象的Show方法显示对话框，点击确定返回-1，点击取消返回0
   
7.             MsgBox "您选择的文件夹是：" & .SelectedItems(1), vbOKOnly + vbInformation, "提示"
   
8.         End If
   
9.     End With
   

复制代码

lcxq120713

ykcbf1100 发表于 2024-5-30 15:46
动态选择文件夹。

你好老师,基于我提供的这段VBA,怎么修改呢?辛苦指正一下,感谢!

quqiyuan

供参考

ykcbf1100

lcxq120713 发表于 2024-5-31 14:21
你好老师,基于我提供的这段VBA,怎么修改呢?辛苦指正一下,感谢!

你上传附件吧。
代码得重写一个。

quqiyuan

Sub 取数据()
Dim str As String
Dim wb As Workbook
Dim i, j As Integer
Excel.Application.DisplayAlerts = False
Excel.Application.ScreenUpdating = False
Sheet1.Range("A3:AO5000").ClearContents
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "请选择文件夹"
    .InitialFileName = ThisWorkbook.Path & "\"
    If .Show = -1 Then
        p = .SelectedItems(1) & ""
    Else
        Exit Sub
    End If
End With
str = Dir(p & "\*.xls*")
For i = 1 To 100
    Set wb = Workbooks.Open(p & "\" & str)
    i = wb.Sheets(1).Range("A5000").End(xlUp).Row
    j = ThisWorkbook.Sheets("数据").Range("A5000").End(xlUp).Row
    wb.Sheets(1).Range("A3:AO" & i).Copy ThisWorkbook.Sheets("数据").Range("a" & j + 1)
    wb.Close
    str = Dir
    If str = "" Then
        Exit For
    End If
Next
Excel.Application.DisplayAlerts = True
Excel.Application.ScreenUpdating = True
End Sub

lcxq120713

quqiyuan 发表于 2024-5-31 14:34
Sub 取数据()
Dim str As String
Dim wb As Workbook

可以了,谢谢!