word按26个字母开头分别导出为Excel-18-7-12
Sub qwe1111()
Dim app_excel As Excel.Application
Dim book_excel As Excel.Workbook
Dim str As String
Dim i, j As Integer
For j = 65 To 90
For i = 97 To 122
selection.HomeKey wdStory
With selection.Find
.Text = ChrW(j) + ChrW(i) + "[!^13]@^13" + "[" + ChrW(j) + ChrW(i) + "]" + "[!" + ChrW(i) + "]"
.MatchWildcards = True
.Replacement.Text = ""
.Wrap = wdFindStop
.Forward = True
.Execute
If selection.Find.Found Then
selection.MoveLeft wdCharacter, 1
selection.Paragraphs(1).Range.Select
Set aimrng = ActiveDocument.Range(ActiveDocument.Range.Start, selection.Paragraphs(1).Range.End)
aimrng.Select
selection.Cut
Set app_excel = New Excel.Application '申请一个Excel.Application内存空间
Set book_excel = app_excel.Workbooks.Add
book_excel.SaveAs ("d:\abbbbbb\" + ChrW(j) + ChrW(i) + ".xlsx")
book_excel.Sheets("sheet1").Paste
book_excel.Close 1
End If
End With
Next i
Next j
End Sub