[已解决]保存名称含路径

乐乐2006201506 · 发表于 2016-6-14 20:17

本帖最后由乐乐2006201506 于 2016-6-14 21:07 编辑

怎样将下面代码中创建的文本文件名和打开文件的文件名（保存公式）一致，并使保存的文本文件名内含打开文件的路径。假如原文件（保存文件.xlsm）在桌面，即将文本文件保存为“保存公式 C Users YYB Desktop.txt”,谢谢！

Sub 读取公式并存入文本文件()
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim Row As Integer, myfile$, objFolder
Dim fso As Scripting.filesystemobject
Dim mt As Scripting.textstream
'创建Range对象
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)
'没有找到公式
If FormulaCells Is Nothing Then
MsgBox "当前工作表中没有公式！"
Exit Sub
End If
Set objFolder = objShell.BrowseForFolder(0, "请选择文件存放位置", 0, 0)
If Not objFolder Is Nothing Then
mypath = objFolder.self.Path
Else
mypath = ""
Exit Sub
End If
myfile = mypath & "\" & Replace(ThisWorkbook.Name, ".xlsm", "") & ".txt"
Set fso = New Scripting.filesystemobject
Set mt = fso.createtextfile(Filename:=myfile, overwrite:=True)
'读取公式，同时在状态栏中显示进度。
For Each Cell In FormulaCells
mt.write Cell.Address(RowAbsolute:=False, ColumnAbsolute:=False) & vbCrLf
mt.write Cell.Formula & vbCrLf
Next
mt.Close
MsgBox "公式保存成功！"
End Sub

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-14 20:33

乐乐2006201506 发表于 2016-6-14 20:27
将文本文件保存为“保存公式 C Users YYB Desktop.txt”可以吗？即将“\”，“:”换 ...

能跟我讲讲这么做的目的吗?{:101:}

Sub 读取公式并存入文本文件()
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim Row As Integer, myfile$, objFolder
Dim fso As Scripting.FileSystemObject
Dim mt As Scripting.TextStream
'创建Range对象
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)
'没有找到公式
If FormulaCells Is Nothing Then
MsgBox "当前工作表中没有公式！"
Exit Sub
End If
Set objFolder = objShell.BrowseForFolder(0, "请选择文件存放位置", 0, 0)
If Not objFolder Is Nothing Then
mypath = objFolder.self.Path
Else
mypath = ""
Exit Sub
End If
myfile = mypath & "" & Replace(Replace(mypath, "", " "), ":", " ") & Replace(ThisWorkbook.Name, ".xlsm", "") & ".txt"
Set fso = New Scripting.FileSystemObject
Set mt = fso.CreateTextFile(Filename:=myfile, overwrite:=True)
'读取公式，同时在状态栏中显示进度。
For Each Cell In FormulaCells
mt.Write Cell.Address(RowAbsolute:=False, ColumnAbsolute:=False) & vbCrLf
mt.Write Cell.Formula & vbCrLf
Next
mt.Close
MsgBox "公式保存成功！"
End Sub

复制代码

跳转到最佳答案楼层

老司机带带我 · 发表于 2016-6-14 20:24

做不到，文件名不允许有“\”，“:”这些字符！

乐乐2006201506 · 发表于 2016-6-14 20:27

老司机带带我发表于 2016-6-14 20:24
做不到，文件名不允许有“\”，“:”这些字符！

将文本文件保存为“保存公式 C Users YYB Desktop.txt”可以吗？即将“\”，“:”换为空格“ ”，谢谢！

老司机带带我 · 发表于 2016-6-14 20:33

乐乐2006201506 发表于 2016-6-14 20:27
将文本文件保存为“保存公式 C Users YYB Desktop.txt”可以吗？即将“\”，“:”换 ...

能跟我讲讲这么做的目的吗?{:101:}

Sub 读取公式并存入文本文件()
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim Row As Integer, myfile$, objFolder
Dim fso As Scripting.FileSystemObject
Dim mt As Scripting.TextStream
'创建Range对象
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)
'没有找到公式
If FormulaCells Is Nothing Then
MsgBox "当前工作表中没有公式！"
Exit Sub
End If
Set objFolder = objShell.BrowseForFolder(0, "请选择文件存放位置", 0, 0)
If Not objFolder Is Nothing Then
mypath = objFolder.self.Path
Else
mypath = ""
Exit Sub
End If
myfile = mypath & "" & Replace(Replace(mypath, "", " "), ":", " ") & Replace(ThisWorkbook.Name, ".xlsm", "") & ".txt"
Set fso = New Scripting.FileSystemObject
Set mt = fso.CreateTextFile(Filename:=myfile, overwrite:=True)
'读取公式，同时在状态栏中显示进度。
For Each Cell In FormulaCells
mt.Write Cell.Address(RowAbsolute:=False, ColumnAbsolute:=False) & vbCrLf
mt.Write Cell.Formula & vbCrLf
Next
mt.Close
MsgBox "公式保存成功！"
End Sub

复制代码

乐乐2006201506 · 发表于 2016-6-14 20:41

老司机带带我发表于 2016-6-14 20:33
能跟我讲讲这么做的目的吗?

谢谢您！后边做的目的就是让我知道源文件保存位置，不然到时候提取公式的文本文件在，但不知道源文件保存在哪？这样的话不是很郁闷吗？
当然在自己求教的过程中，也会慢慢学会运用VBA代码，一举二得。

fjmxwrs · 发表于 2016-6-14 20:43

乐乐2006201506 发表于 2016-6-14 20:41
谢谢您！后边做的目的就是让我知道源文件保存位置，不然到时候提取公式的文本文件在，但不知道源 ...

实在想不明白，用VBA处理了，为什么不直接把公式用VBA的来处理呢，非保存公式再写入公式，想不明白

乐乐2006201506 · 发表于 2016-6-14 20:45

本帖最后由乐乐2006201506 于 2016-6-14 20:48 编辑

能将路径放在文件名后边吗？我自己试了一下，没有成功！

这个问题已解决，谢谢！

没有成功是因为我把公式位置弄错了。谢谢啊！

老司机带带我 · 发表于 2016-6-14 20:45

乐乐2006201506 发表于 2016-6-14 20:41
谢谢您！后边做的目的就是让我知道源文件保存位置，不然到时候提取公式的文本文件在，但不知道源 ...

嗯，每个人的目的和初衷是不一样的，用户需求是王~

老司机带带我 · 发表于 2016-6-14 20:49

乐乐2006201506 发表于 2016-6-14 20:45
能将路径放在文件名后边吗？我自己试了一下，没有成功！

Sub 读取公式并存入文本文件()
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim Row As Integer, myfile$, objFolder
Dim fso As Scripting.FileSystemObject
Dim mt As Scripting.TextStream
'创建Range对象
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)
'没有找到公式
If FormulaCells Is Nothing Then
MsgBox "当前工作表中没有公式！"
Exit Sub
End If
Set objFolder = objShell.BrowseForFolder(0, "请选择文件存放位置", 0, 0)
If Not objFolder Is Nothing Then
mypath = objFolder.self.Path
Else
mypath = ""
Exit Sub
End If
myfile = mypath & "" & Replace(ThisWorkbook.Name, ".xlsm", "") & Replace(Replace(mypath, "", " "), ":", " ") & ".txt"
Set fso = New Scripting.FileSystemObject
Set mt = fso.CreateTextFile(Filename:=myfile, overwrite:=True)
'读取公式，同时在状态栏中显示进度。
For Each Cell In FormulaCells
mt.Write Cell.Address(RowAbsolute:=False, ColumnAbsolute:=False) & vbCrLf
mt.Write Cell.Formula & vbCrLf
Next
mt.Close
MsgBox "公式保存成功！"
End Sub

复制代码

乐乐2006201506 · 发表于 2016-6-14 21:05

本帖最后由乐乐2006201506 于 2016-6-14 21:13 编辑

fjmxwrs 发表于 2016-6-14 20:43
实在想不明白，用VBA处理了，为什么不直接把公式用VBA的来处理呢，非保存公式再写入公式，想不明白

   为什么把公式不用VBA处理，是因为我有好多公式，而且以前的公式现在一个一个求助别人总不如自己用这个代码将所有的公式一次性解决的好，当然以后有时间，有机会了，再来慢慢求助各位大师，将重要的公式用VBA来处理。我这样做的原因是因为文件中有公式，有时引用出了问题，当把文件发给别人后会出现乱码，比较麻烦，而将公式清除后，就可以解决这个问题；还有就是VBA代码保存的文件好多人还不能接受，怕宏中毒。
      但您可能会问，自己电脑上保存的正确，重新给发一个，或者在自己电脑上保存一份有公式的，一份没有公式的，那样的话，文件乱，而且时间长了，引用的源数据变化后，得将两个文件中的内容都修改（没有公式的数据不会自动变化），处理起来费时费力易出错，而我这样做了之后，只要源数据有变动，我将公式导入，计算出正确结果后，直接保存，只保存一次，而且不容易出错，您说是不是呢？
      当然这样做还有很多好处，就是既长了知识，又达到了自己特殊的目的（有些问题可能真的是匪夷所思的，而且难度会很大，只能一个一个问题来解决，最终解决了一个大问题，呵呵……）。
      当然不客气来说，还是“老司机带带我”老师说得好“用户需求是王~”。其实与其质疑，不如尽力帮助。
      无论如何，还是谢谢您的关注！
      曾经也得到过您的帮助。
      也希望今后能得到您的帮助！
      还有一点就是通过这种方式，我感觉学习VBA更快，更实用。呵呵……
      不论如何，希望您大人有大量，不计较我有些冲动的话语，最后还是谢谢您！

		自动登录	找回密码
密码			注册

[已解决]保存名称 含路径

[已解决]保存名称含路径