Блог

Поэтому я пытаюсь сохранить рабочий лист Excel в виде .Файл PRN на рабочий стол текущего пользователя. Я подумал, что, может быть, есть стандартный оператор «подстановочный знак», который я мог бы использовать, но я нигде этого не вижу. Я просмотрел переполнение стека и нашел информацию, которая, вероятно, является тем, что я ищу, но из-за того, что я не программист и не очень хорошо разбираюсь в excel, я не знаю, то ли это то, что я хочу, и если да, то где это поместить в мой код.

Это то, что я сейчас запускаю, работает только на моей машине:

 Sub Save_PRN()
Dim fileName As String
fileName = "C:UserscameronDesktopPRN Test files" amp; Range("'Customer_Info'!R2").Text amp; ".prn"
ActiveWorkbook.SaveAs fileName:=fileName, FileFormat:=xlTextPrinter, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
 

Хотя он делает то, что я хочу, когда я загружаю его в нашу общую папку, очевидно, что другой пользователь не сможет его использовать. Я видел, как на вопрос, на который кто-то ответил, говорилось, чтобы использовать это:

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

Но я не знаю и не понимаю, как включить это в мой макрос выше. Любая помощь или совет были бы замечательны. Я вообще на правильном пути?

Хотя решение roryap прекрасно и работает, я хотел бы добавить еще одно рабочее решение.

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

Вы можете использовать его вот так:

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

Решение состоит в том, чтобы «маркировать» эти стандартные папки как символы, которые могут заменять стандартный путь к папке при сохранении данных и расширяться в локально определенные специальные папки следующей машины при повторном чтении данных.

Я не знаю какого-либо общепринятого набора жетонов (ярлыков, имен, сокращений или вульгарных ругательств) для этого: я был бы признателен, если бы кто-нибудь мог просветить меня, если есть, потому что это очень распространенная задача, и я ненавижу изобретать велосипед.

Красиво вырезанные квадратные колеса ниже станут интересной темой для разговора в вашей квартире и неуклюжим решением вашей проблемы: все, что вам нужно сделать, это сохранить путь вниз с помощью функции «Заменить» ниже, каждый раз, когда вы записываете и сохраняете путь к папке в хранилище данных…

…И считывайте путь с помощью функции «Развернуть» каждый раз, когда вы извлекаете путь к папке из хранилища данных и используете его для открытия папки.

Клац, клац, клац: это характерный звук недавно изобретенного «Колеса» в движении. У меня тоже есть несколько действительно интересных проектов для термоядерной мышеловки на сайте Excellerando: найдите термин «Ужасный взлом».

 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 
 

 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