Sub ExtractDataFromFiles()
Dim FolderPath As String
Dim FileName As String
Dim SpecificText As String
Dim cn As Object
Dim rs As Object
Dim ws As Worksheet
Dim NewBook As Workbook
Dim NewSheet As Worksheet
Dim Row As Long
Dim Col As Long
FolderPath = "C:\Your\Folder\Path\" ' 폴더 경로를 지정하세요.
SpecificText = "특정글자" ' 특정 글자를 지정하세요.
Set NewBook = Workbooks.Add
Set NewSheet = NewBook.Sheets(1)
Row = 1
Col = 1
FileName = Dir(FolderPath & "*.xlsx")
Do While FileName <> ""
If InStr(FileName, SpecificText) > 0 Then
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FolderPath & FileName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT * FROM [요구$A3:Z10000]", cn, 1, 3
Do While Not rs.EOF
For Col = 0 To rs.Fields.Count - 1
NewSheet.Cells(Row, Col + 2).Value = rs.Fields(Col).Value
Next Col
NewSheet.Cells(Row, 1).Value = Mid(FileName, InStr(FileName, SpecificText) + Len(SpecificText))
rs.MoveNext
Row = Row + 1
Loop
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End If
FileName = Dir
Loop
' 취합한 결과를 저장하는 코드 추가
NewBook.SaveAs FolderPath & "취합결과파일.xlsx"
NewBook.Close
End Sub
카테고리 없음
댓글