大神求助:如何批量将若干txt或doc文档内每个段落,都解构转换成以段落内容命名的txt?
大神求助:如何批量将若干txt或doc文档内每个段落,都解构转换成以段落内容命名的txt?【段落字符数超过255个或段落中有不可命名的特殊符号/ \ : * < | ,想办法忽略掉吧,谢谢】
Private 路徑 As String, 檔名 As String Private Sub Command1_Click() Dim 內容 As String, 章節1 As String, 章節2 As String, LineFromFile As String 內容 = "" 路徑 = Text1.Text 檔名 = Text2.Text 章節1 = "序" FilePath = 路徑 & 檔名 Open FilePath For Input As #1 ' 開啟 FilePath 文字檔,使用編號 #1 檔案代 Do Until EOF(1) ' 執行迴圈,直到編號 #1 檔案遇到結尾為止 Line Input #1, LineFromFile ' 從編號 #1 檔案讀取一行資料 LineFromFile = 替換字符(LineFromFile) 章節2 = 取章節(LineFromFile) If 章節2 <> "" Then Call 寫入TXT(路徑 & 章節1 & ".txt", 章節1 & vbCrLf & 內容) 章節1 = 章節2 內容 = "" Else 內容 = 內容 & LineFromFile & vbCrLf ' ' 輸出一行資料 End If Loop Close #1 ' 關閉編號 #1 檔案 End Sub Function 替換字符(str1 As String) '/ \ : * < | Dim 字串 As String 字串 = Replace(str1, "/", "") '替換字符1開始返回 字串 = Replace(字串, "\", "") 字串 = Replace(字串, ":", "") 字串 = Replace(字串, "*", "") 字串 = Replace(字串, "<", "") 字串 = Replace(字串, "|", "") 字串 = Replace(字串, "?", "?") 字串 = Replace(字串, ".", "") 字串 = Replace(字串, "·", "") 替換字符 = 字串 End Function Function 取章節(str2 As String) 是否章節 = 0 結果1 = InStr(str2, "第") '往後 正查字符 結果2 = InStr(str2, "章") '往後 正查字符 If 結果1 > 0 And 結果2 > 0 Then 章節 = Mid(str2, 結果1) 取章節 = 章節 End If 'Debug.Print 結果1 & "," & 結果2 & "=" & 章節 End Function Private Function 寫入TXT(ByVal OutputFilePath As String, Content As String) '路徑 ,內容 Open OutputFilePath For Output As #2 ' 開啟 OutputFilePath 文字檔,使用編號 #2 檔案代碼 Print #2, Content ' 將 Content 的內容寫入編號 #2 的檔案 Close #2 ' 關閉編號 #2 檔案 End Function Private Sub Text1_Change() '變更時更新參數 If Text1.CausesValidation Then 路徑 = Text1.Text End Sub Private Sub Text2_Change() '變更時更新參數 If Text2.CausesValidation Then 檔名 = Text2.Text End Sub
[此贴子已经被作者于2022-3-7 16:33编辑过]