win7下剪贴板保存为自定格式文本

窄口牛

找ai写了个脚本，复制回来是utf8格式，unix（LF）换行符，是不是很不方便？
我这个就是解决这个问题

1. Option Explicit
   
2. Sub Main()
   
3.     On Error Resume Next
   
4.     Dim clipboardText
   
5.     clipboardText = GetClipboardText()
   
6.     If IsEmpty(clipboardText) Then
   
7.         MsgBox "剪贴板中没有文本内容或无法访问剪贴板！", vbExclamation, "错误"
   
8.         Exit Sub
   
9.     End If
   
10.     If clipboardText = "" Then
    
11.         MsgBox "剪贴板中没有文本内容！", vbExclamation, "错误"
    
12.         Exit Sub
    
13.     End If
    
14.     Dim convertedText
    
15.     convertedText = ConvertTextFormat(clipboardText)
    
16.     Dim filePath
    
17.     filePath = ShowSaveDialog()
    
18.     If filePath = "" Then
    
19.         Exit Sub
    
20.     End If
    
21.     If SaveTextToFile(convertedText, filePath) Then
    
22.         MsgBox "文件保存成功！" & vbCrLf & "路径：" & filePath, vbInformation, "成功"
    
23.     Else
    
24.         MsgBox "文件保存失败！", vbExclamation, "错误"
    
25.     End If
    
26. End Sub
    
27. Function GetClipboardText()
    
28.     On Error Resume Next
    
29.     Dim objHTML, clipboardText
    
30.     Set objHTML = CreateObject("htmlfile")
    
31.     clipboardText = objHTML.ParentWindow.ClipboardData.GetData("text")
    
32.     If Err.Number <> 0 Then
    
33.         Err.Clear
    
34.         Dim objShell
    
35.         Set objShell = CreateObject("WScript.Shell")
    
36.         Dim tempFile, objFSO
    
37.         Set objFSO = CreateObject("Scripting.FileSystemObject")
    
38.         tempFile = objFSO.GetSpecialFolder(2) & "\clipboard_temp.txt"
    
39.         objShell.Run "powershell -Command Get-Clipboard | Out-File -FilePath """ & tempFile & """ -Encoding UTF8", 0, True
    
40.         WScript.Sleep 500 ' 等待文件写入
    
41.         If objFSO.FileExists(tempFile) Then
    
42.             Dim objStream
    
43.             Set objStream = CreateObject("ADODB.Stream")
    
44.             objStream.Charset = "UTF-8"
    
45.             objStream.Open
    
46.             objStream.LoadFromFile tempFile
    
47.             clipboardText = objStream.ReadText
    
48.             objStream.Close
    
49.             objFSO.DeleteFile tempFile, True
    
50.         End If
    
51.     End If
    
52.     GetClipboardText = clipboardText
    
53.     Set objHTML = Nothing
    
54. End Function
    
55. Function ConvertTextFormat(text)
    
56.     Dim converted
    
57.     converted = Replace(text, vbCrLf, vbLf)     ' 先将CRLF转为LF
    
58.     converted = Replace(converted, vbCr, vbLf)  ' 将CR转为LF
    
59.     converted = Replace(converted, vbLf, vbCrLf) ' 最后将所有LF转为CRLF
    
60.     If Len(converted) >= 3 Then
    
61.         If AscB(MidB(converted, 1, 1)) = &HEF And _
    
62.            AscB(MidB(converted, 2, 1)) = &HBB And _
    
63.            AscB(MidB(converted, 3, 1)) = &HBF Then
    
64.             converted = Mid(converted, 2) ' 跳过BOM
    
65.         End If
    
66.     End If
    
67.     ConvertTextFormat = converted
    
68. End Function
    
69. Function ShowSaveDialog()
    
70.     Dim objShell, objFolder, tempPath, fileName
    
71.     Set objShell = CreateObject("WScript.Shell")
    
72.     fileName = "clipboard_content_" & FormatDateTime(Now, 2) & "_" & Replace(FormatDateTime(Now, 4), ":", "") & ".txt"
    
73.     Dim filePath
    
74.     filePath = InputBox("请输入要保存的文件路径：" & vbCrLf & vbCrLf & _
    
75.                        "支持的文件格式：.txt, .log, .csv, .ini, .xml等", _
    
76.                        "保存剪贴板内容", _
    
77.                        objShell.ExpandEnvironmentStrings("%USERPROFILE%\Desktop") & fileName)
    
78.     If filePath = "" Then
    
79.         ShowSaveDialog = ""
    
80.         Exit Function
    
81.     End If
    
82.     Dim objFSO
    
83.     Set objFSO = CreateObject("Scripting.FileSystemObject")
    
84.     If InStr(objFSO.GetFileName(filePath), ".") = 0 Then
    
85.         filePath = filePath & ".txt"
    
86.     End If
    
87.     ShowSaveDialog = filePath
    
88.     Set objFSO = Nothing
    
89.     Set objShell = Nothing
    
90. End Function
    
91. Function SaveTextToFile(text, filePath)
    
92.     On Error Resume Next
    
93.     Dim objStream, objFSO
    
94.     Set objFSO = CreateObject("Scripting.FileSystemObject")
    
95.     Dim folderPath
    
96.     folderPath = objFSO.GetParentFolderName(filePath)
    
97.     If Not objFSO.FolderExists(folderPath) Then
    
98.         objFSO.CreateFolder folderPath
    
99.     End If
    
100.     Set objStream = CreateObject("ADODB.Stream")
     
101.     objStream.Type = 2 ' 文本类型
     
102.     objStream.Charset = "gb2312" ' 使用GB2312编码（ANSI中文环境）
     
103.     objStream.Open
     
104.     objStream.WriteText text
     
105.     objStream.SaveToFile filePath, 2 ' 2 = 覆盖已存在文件
     
106.     objStream.Close
     
107.     If Err.Number = 0 Then
     
108.         SaveTextToFile = True
     
109.     Else
     
110.         SaveTextToFile = False
     
111.     End If
     
112.     Set objStream = Nothing
     
113.     Set objFSO = Nothing
     
114. End Function
     
115. Main

复制代码

剪贴板输出文字.rar (1.5 KB, 下载次数: 6)

昨天 15:14 上传

点击文件名下载附件
下载积分: 无忧币 -2

邪恶海盗

有记得有很多这种剪切板管理工具的，没必要重复造轮子...


二○二五年十月二十七日

it323

感谢分享！

yyz2191958

下来试一试 谢谢

yyz2191958

10 PE 使用不了

a66

看起来不错，暂时用不上，留给需要的人

wn168cn@163.com

支持原创

窄口牛

邪恶海盗 发表于 2025-10-27 15:47
有记得有很多这种剪切板管理工具的，没必要重复造轮子...

它们回来都是utf-8且LF换行符，没有这个修改格式能力。

pole87898843

那天问ai，加上这个就能输出ANSI
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2
stream.Charset = "gb2312"
stream.Open

sdb5168

感谢分享

ebaqiang

感谢分享！

seeimpact153

感谢分享

afti

感谢楼主分享！

小灰兔

感谢分享

likeyouli

这个我前段时间刚研究过，http://bbs.wuyou.net/forum.php?mod=viewthread&tid=447416  见2楼,主要是这段代码,vba通过调用ps生成的:Set oShell = CreateObject("WScript.Shell")
    psCommand = "powershell -Command " & """$bytes = [System.Text.Encoding]::UTF8.GetBytes('" & strText & "'); " & _
                "$stream = [System.IO.File]::Create('" & filepath1 & "'); " & "$stream.Write($bytes, 0, $bytes.Length); " & "$stream.Close()"""
    oShell.Run psCommand, 1, True
    Set oShell = Nothing
我是通过vba，要求输出的必须是utf-8（不带BOM)  ,  默认好像是输出的要么是ansi,要么是utf-8带BOM

窄口牛

我研究不了，都来自深索。感觉现在深索进化了不少，出错率低了，在写vbs脚本方面。