문서를 실행하시면 컨텐츠 사용여부를 묻는 메세지가 나옵니다.
반드시 허용하셔야 합니다.
1. 폴더 가져오기로 해당 폴더의
워드파일들을 가져옵니다.
너무 많으면 오류가 발생할 수 있으므로 적당한 수로 나누어서 하시기 바랍니다.
한 50개 정도는 문제가
없었던거 같습니다.
2. 문서 중에 검색 대상이 아닌 문서는 목록에서 선택하신 후 리스트 1건 삭제 버튼을 클릭하시면 됩니다.
3. 검색단어 에 검색할 단어를 입력하시고 하단의 자료추출 버튼을 클릭하시면됩니다.
4. 검색조건은 몇개의 파일을
하나의 결과문서에 나타낼지를 정하는 것입니다.
예를 들어 50개 문서에 검색조건 10을 선택하면 결과문서는 5개가 나옵니다.
오류가 발생하는 경우가 있습니다. 이 때는 매크로 창에서 도구->참조 창을 엽니다.
사용가능한 참조 들 중에 앞에
'누락-'으로 시작하는 항목들이 있는데 이 것들의 체크박스를 풀어주시면 정상적으로 수행될 것입니다.
한번 써보시면 쉽게 될
겁니다.
--------------------------------------------
문서 검색.docmPrivate Sub CommandButton1_Click()
getFolder
End Sub
Private Sub CommandButton2_Click()
getSentense
End Sub
Sub goCopy()
varCnt = ListBox1.ListCount
fileCnt = TextBox2.Value
i = 0
Do While i < varCnt
fileNum = i Mod fileCnt
If fileNum = 0 Then
If i = 0 Then
Else
ActiveDocument.Close SaveChanges:=wdSaveChanges
End If
ChangeFileOpenDirectory TextBox1.Text
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
newFileName = "복사대상" & i + 1 & "-" & i + fileCnt & Date & Hour(Time) & Minute(Time) & Second(Time) & ".docx"
ActiveDocument.SaveAs FileName:=newFileName
End If
fileVal = ListBox1.List(i)
chkLen = InStr(fileVal, "-")
fileVal = Left(fileVal, chkLen - 1)
'복사할 대상을 열어 복사함
Documents.Open FileName:=fileVal, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
Selection.WholeStory
Selection.Copy
Documents(fileVal).Close
'새 파일을 저장한 위치로 옮김.
ChangeFileOpenDirectory TextBox1.Text
Documents(newFileName).Activate
Documents(newFileName).Select
'새파일의 맨 뒤로 이동함.
Selection.EndKey Unit:=wdStory
'붙혀넣기 전에 링크를 추가함
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
fileVal, SubAddress:="", ScreenTip:="", TextToDisplay:=fileVal
'붙여 넣기함.
Selection.PasteAndFormat (wdPasteDefault)
' 맨 뒤로 이동하여 다음 파일 붙여넣기 준비함
Selection.EndKey Unit:=wdStory
'다음 페이지로 넘어가기 ctr+enter
Selection.InsertBreak Type:=wdPageBreak
i = i + 1
Loop
ActiveDocument.Save
End Sub
Sub getFolder()
'각종 변수 선언
Dim strPath As String
Dim strNm As String
Dim i As Integer
Dim fdFolder As FileDialog
Dim lngCount As Long
' 현재 있는 데이터를 모두 삭제해야 함.
ListBox1.Clear
'서브폴더의 내용을 가져옴
Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)
With fdFolder
.Title = "검색할 폴더를 선택 하세요"
If .Show = -1 Then
folderspec = .SelectedItems(1) '선택한 폴더명을 A3 셀에 저장
getSubFolder (folderspec)
End If
End With
TextBox1.Text = folderspec
TextBox11.Text = ListBox1.ListCount
TextBox2.Text = ListBox1.ListCount
End Sub
Sub getSubFolder(folderspec)
Dim result As String
Dim strFilter As String
Dim Msg As String
Dim strDir As String
Dim r As Long
strDir = folderspec
If strDir = "" Then
MsgBox (" 선택된 폴더가 없습니다. 폴더를 선택하세요.")
Exit Sub
End If
r = 1
r = r + 1
If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"
strFilter = "*.doc*"
result = sRetrieve(strDir, strFilter, r)
End Sub
Private Function sRetrieve(sPath As String, strFilter As String, r As Long) As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set dDirs = fs.getFolder(sPath)
For Each dDir In dDirs.SubFolders
sRetrieve = sRetrieve(dDir.Path, strFilter, r)
Next
For Each fFile In dDirs.Files
If fFile.Name Like strFilter Then
If Left(fFile.Name, 1) = "~" Then
Else
ListBox1.AddItem fFile.Path & "-" & fFile.Size
End If
r = r + 1
End If
Next
Set fs = Nothing
End Function
Private Sub CommandButton3_Click()
'Ensure ListBox contains list items
If ListBox1.ListCount >= 1 Then
'If no selection, choose last list item.
If ListBox1.ListIndex = -1 Then
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
ListBox1.RemoveItem (ListBox1.ListIndex)
End If
TextBox11 = ListBox1.ListCount
End Sub
Private Sub ListBox1_Click()
TextBox3.Text = ListBox1
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
selName = ListBox1
docNameLen = Len(selName)
chkLen = InStr(selName, "-")
selName = Left(selName, chkLen - 1)
Documents.Open (selName)
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
copyName = ListBox2
Documents.Open (copyName)
End Sub
Sub getSentense()
varCnt = ListBox1.ListCount
fileCnt = TextBox2.Value
targetText = TextBox4.Value
i = 0
Do While i < varCnt
fileNum = i Mod fileCnt
If fileNum = 0 Then
If i = 0 Then
Else
ActiveDocument.Close SaveChanges:=wdSaveChanges
End If
ChangeFileOpenDirectory TextBox1.Text
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
newFileName = "복사대상" & TextBox2.Text & i + 1 & "-" & i + fileCnt & Date & Hour(Time) & Minute(Time) & Second(Time) & ".docx"
ActiveDocument.SaveAs FileName:=newFileName
End If
fileVal = ListBox1.List(i)
chkLen = InStr(fileVal, "-")
fileVal = Left(fileVal, chkLen - 1)
sendVal = newFileName & "*" & fileVal
'복사할 대상을 열어 복사함
Documents.Open FileName:=fileVal, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
'자료찾아복사하는 함수 호출함.
chkexeval = True
Do While chkexeval = True
Selection.Find.ClearFormatting
With Selection.Find
.Text = targetText
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.CorrectHangulEndings = True
.HanjaPhoneticHangul = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
chkexeval = Selection.Find.Execute
If chkexeval = True Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
' Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveRight Unit:=wdWord, Count:=7, Extend:=wdExtend
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, Count:=1
End If
'새 파일을 저장한 위치로 옮김.
ChangeFileOpenDirectory TextBox1.Text
Documents(newFileName).Activate
Documents(newFileName).Select
'새파일의 맨 뒤로 이동함.
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
'붙혀넣기 전에 링크를 추가함
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
fileVal, SubAddress:="", ScreenTip:="", TextToDisplay:=fileVal
'붙여 넣기함.
Selection.PasteAndFormat (wdFormatPlainText)
Selection.TypeText (vbTab)
Selection.TypeText (chkexeval)
Selection.TypeText (vbTab)
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Documents(fileVal).Activate
Loop
Documents(fileVal).Close
i = i + 1
Loop
ActiveDocument.Save
End Sub
Sub goCopyTitle(sendVal)
txtLen = Len(sendVal)
End Sub
Rss Feed