如何保存到当前用户\桌面位置

时间:2015-06-17 15:06:51

标签: excel excel-vba vba

所以我试图将excel工作表作为.PRN文件保存到当前用户桌面。我想也许我可以使用一个标准的“通配符”操作符,但我没有看到任何地方。我已经查看了堆栈溢出,我发现可能是我正在寻找的信息,但由于我不是程序员而且不是很好用excel,我不知道它是否是我想要的,如果是,把它放在我的代码中的哪个位置。

这是我目前正在运行的,只能在我的机器上运行:

Sub Save_PRN()
Dim fileName As String
fileName = "C:\Users\cameron\Desktop\PRN Test files\" & Range("'Customer_Info'!R2").Text & ".prn"
ActiveWorkbook.SaveAs fileName:=fileName, FileFormat:=xlTextPrinter, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

虽然它可以实现我想要的功能,但当我将其上传到我们的共享时,显然另一个用户将无法使用它。我看到一个问题,有人回答说要用这个:

MsgBox CreateObject("WScript.Shell").specialfolders("Desktop")

但我不知道或不了解如何将其纳入上面的宏。任何帮助或建议都会很棒。我甚至走在正确的轨道上吗?

3 个答案:

答案 0 :(得分:3)

虽然roryap的解决方案非常精细且有效,但我想添加另一种可行的解决方案。

Dim strPath as String
strFileName = Environ("USERPROFILE") & "\Desktop\PRN Test files\" & Range("'Customer_Info'!R2").Text & ".prn"
ActiveWorkbook.SaveAs fileName:=strFileName, FileFormat:=xlTextPrinter, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

答案 1 :(得分:1)

你可以像这样使用它:

Dim desktopFolderPath As String
desktopFolderPath = CreateObject("WScript.Shell").specialfolders("Desktop")
fileName = desktopFolderPath & "\PRN Test files\" & Range("'Customer_Info'!R2").Text & ".prn"

答案 2 :(得分:0)

解决方案是“标记化”'这些标准文件夹作为符号,可以在保存数据时替换标准文件夹路径,并在再次读取数据时扩展到下一台计算机的本地定义的特殊文件夹中。

我不知道有任何普遍接受的令牌(标签,名称,缩写或粗俗的诅咒):如果有人可以启发我,我将不胜感激,因为这是这是一项非常普遍的任务,我讨厌重新发明轮子。

下面精美雕刻的方形轮子将为您的公寓提供一个有趣的谈话片段,并为您的问题提供一个笨重的解决方案:您所要做的就是通过“替代品”拯救道路。以下功能,每次捕获并保存数据存储的文件夹路径 ...

...并使用'展开'阅读路径函数每次从数据存储中检索文件夹路径并使用它来打开文件夹

Clunk,clunk,clunk:这是新发明的' Wheel'的独特声音。在运动中。我在Excellerando Blogspot上有一些非常有趣的热核捕鼠器设计:搜索“可怕的黑客”一词。

Public Function SubstituteStandardFolders(ByVal strPath As String) As String
' Insert abbreviations for standard folders 
Dim strUser As String Dim strDesk As String Dim strAppD As String Dim strDocs As String Dim strTemp As String
strDesk = CreateObject("WScript.Shell").SpecialFolders("Desktop") strDocs = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") strAppD = CreateObject("WScript.Shell").SpecialFolders("AppData") strTemp = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) strUser = CreateObject("WScript.Network").UserName
strPath = Replace(strPath, strDesk, "[Desktop]", , , vbTextCompare) strPath = Replace(strPath, strDocs, "[My Documents]", , , vbTextCompare) strPath = Replace(strPath, strAppD, "[Application Data]", , , vbTextCompare) strPath = Replace(strPath, strTemp, "[Temp]", , , vbTextCompare) strPath = Replace(strPath, strUser, "[User]", , , vbTextCompare)
SubstituteStandardFolders = strPath
End Function

Public Function ExpandStandardFolders(ByVal strPath As String) As String ' Replace abbreviations for standard folders with their full names
Dim strUser As String Dim strDesk As String Dim strAppD As String Dim strDocs As String Dim strTemp As String
strDesk = CreateObject("WScript.Shell").SpecialFolders("Desktop") strDocs = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") strAppD = CreateObject("WScript.Shell").SpecialFolders("AppData") strTemp = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) strUser = CreateObject("WScript.Network").UserName
strPath = Replace(strPath, "[Desktop]", strDesk, , , vbTextCompare) strPath = Replace(strPath, "[My Documents]", strDocs, , , vbTextCompare) strPath = Replace(strPath, "[Application Data]", strAppD, , , vbTextCompare) strPath = Replace(strPath, "[Temp]", strTemp, , , vbTextCompare) strPath = Replace(strPath, "[User]", strUser, , , vbTextCompare)
ExpandStandardFolders = strPath
End Function

注意' Hail Mary'末尾的子句:如果所有其他方法都失败了,则换掉[User]的用户名,并希望在所有其他机器上以相同的方式构建路径。

此代码存在限制。查看令牌列表:

 [Desktop]           [My Documents]      [Application Data]  [Temp]              [User]           

如果您枚举Shell SpecialFolders集合,您将看到不仅仅是:

Public Sub EnumerateSpecialFolders() 
Dim objCollection As Object Dim varX As Variant
Set objCollection = CreateObject("WScript.Shell").SpecialFolders
For Each varX In objCollection Debug.Print varX Next varX
End Sub

但是,我无法从该集合中获取密钥 - 只是值 - 而且序数因系统而异。

如果您能获得密钥,那么这是一套合理的令牌,可供普遍使用。当然,假设我的文件'没有被钥匙' MiaDocumetari'或者贵公司一半工作站上的一串两字节和三字节的unicode。

另外:欢迎来到Deep VBA。这是需要使用方轮式解决方法的琐碎任务,而且我怀疑我们的SDK开发人员库中荒谬过于复杂的工具使我们在更广受尊重的语言中的同事免受这种影响:这些变通方法起源于不良操作系统级别的设计决策,实际上没有人能够解决问题。它们。