我正在下载一个Excel文件，该文件每天都会更改名称，并以随机数结尾。
我正在获取数据并将其复制到我的主文件中。我已经复制/粘贴了。
除了Activesheet之外，还有其他方法可以对其进行编码。我不希望在运行宏时打开并选择特定的Excel文件，因为通常会打开多个Excel文件。
是否可以在不知道全名的情况下选择Excel文件？
这是我的全部代码：
'*******************************************************************************
' Purpose: Updates ...
' Change PartialWorkbookName and the value of cStrPartial (the string).
'*******************************************************************************
Sub PartialWorkbookName()
Const cStrPartial As String = "Task_States_(Pivot)"
Dim objWb As Workbook
For Each objWb In Workbooks
If Left(objWb.Name, Len(cStrPartial)) = cStrPartial Then Exit For
Next
If objWb Is Nothing Then GoTo NotFound
With objWb
'*******************************************************************************
' Code in here
.ActiveSheet.Columns("A:A").Select
'going from horasphere data status+date, making it readable by converting it with the comma and pasting it into your masterfile table.
'have to find a way to have the macro find the file without a name as the name will always change.
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1)), TrailingMinusNumbers:=True
'this top part is to make the data readable by going into Data - Text to columns - etc
'To copy paste the readable data into the masterfile to run the 1st macro
Rows("1:1").Select
Selection.Delete Shift:=xlUp
'Selects all dirty cell in the worksheet that is currently opened only, may need to tweak this later on
ActiveSheet.UsedRange.Select
Selection.Copy
'pastes it into the blank sheet
Windows("macro").Activate
Sheets(3).Select
Range("A1").Select
ActiveSheet.Paste
'deletes the table (have to eventually put that at the beginning of my macro)
Sheets(1).Select
Rows("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Sheets(3).Select
Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(1).Select
Range("A2").Select
ActiveSheet.Paste
Sheets(3).Select
Cells.Select
Selection.ClearContents
Sheets(1).Select
'*******************************************************************************
End With
Set objWb = Nothing
Exit Sub
NotFound:
MsgBox "Workbook not found."
End Sub
'*******************************************************************************
答案 0 :(得分：1)
'*******************************************************************************
' Purpose: Updates ...
' Change PartialWorkbookName and the value of cStrPartial (the string).
'*******************************************************************************
Sub PartialWorkbookName()
Const cStrPartial As String = "Book_20"
Dim objWb As Workbook
For Each objWb In Workbooks
If Left(objWb.Name, Len(cStrPartial)) = cStrPartial Then Exit For
Next
If objWb Is Nothing Then GoTo NotFound
With objWb
'*******************************************************************************
' Code in here
'*******************************************************************************
End With
Set objWb = Nothing
Exit Sub
NotFound:
MsgBox "Workbook not found."
End Sub
'*******************************************************************************
您可以将其减少（不建议使用）：
'*******************************************************************************
' Purpose: Updates ...
' Change PartialWorkbookNameReduced and the value of cStrPartial (the string).
'*******************************************************************************
Sub PartialWorkbookNameReduced(): Const cStrPartial As String = "Book_20"
Dim objWb As Workbook: For Each objWb In Workbooks
If Left(objWb.Name, Len(cStrPartial)) = cStrPartial Then Exit For
Next: If objWb Is Nothing Then GoTo NotFound
With objWb
'*******************************************************************************
' Code in here
'*******************************************************************************
End With: Set objWb = Nothing: Exit Sub
NotFound: MsgBox "Workbook not found."
End Sub
'*******************************************************************************
另外，您可以将Dim行放在第一行，但它超过了80个字符的限制，所以我没有这样做。
在TextToColumns中，我删除了所有带有默认参数的参数。
如果将此代码与您的代码进行比较，您将看到逻辑方式。因此，如果发生错误，您可以轻松地还原零件
错误发生的位置。下载的文件中发生的一切都发生在名为“ Sheet1”的工作表上，介于以下两行之间：
With objWb.Worksheets("Sheet1")
End With
- 此代码所在的工作簿中发生的事情在以下两行之间发生：
With ThisWorkbook
End With
'*******************************************************************************
' Purpose: Updates ...
' Change PartialWorkbookName and the value of cStrPartial (the string).
'*******************************************************************************
Sub PartialWorkbookNamedsf()
Const cStrPartial As String = "Task_States_(Pivot)"
Dim objWb As Workbook
For Each objWb In Workbooks
If Left(objWb.Name, Len(cStrPartial)) = cStrPartial Then Exit For
Next
If objWb Is Nothing Then GoTo NotFound
'*******************************************************************************
With objWb.Worksheets("Sheet1")
' going from horasphere data status+date, making it readable by converting
' it with the comma and pasting it into your masterfile table.
' have to find a way to have the macro find the file without a name as
' the name will always change.
.Columns("A:A").TextToColumns Destination:=.Range("A1"), _
Tab:=True, Comma:=True, TrailingMinusNumbers:=True, FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), _
Array(14, 1), Array(15, 1), Array(16, 1))
' this top part is to make the data readable by going into
' Data - Text to columns - etc
' To copy paste the readable data into the masterfile to run
' the 1st macro
.Rows(1).Delete Shift:=xlUp
' Selects all dirty cell in the worksheet that is currently opened only,
' may need to tweak this later on
.UsedRange.Copy
End With
With ThisWorkbook
' pastes it into the blank sheet
.Sheets(3).Range("A1").Paste
' deletes the table (eventually put this at the beginning of my macro)
.Sheets(1).Rows(3).End(xlDown).Delete Shift:=xlUp
.Sheets(3).Rows(1).End(xlDown).Copy Destination:=.Sheets(1).Range("A2")
.Sheets(3).Cells.ClearContents
.Sheets(1).Select
End With
'*******************************************************************************
Set objWb = Nothing
Exit Sub
NotFound:
MsgBox "Workbook not found."
End Sub
'*******************************************************************************