将Excel工作表另存为.txt

时间:2019-11-10 12:49:47

标签: excel vba

我是VBA的新手。我要执行的任务是保存带有.txt格式的1行的excel工作表。

此刻,我只知道如何按特定方向(例如台式机)保存它。

但是用户是否可以通过弹出窗口(例如另存为)来选择要保存的位置?

Private Sub CommandButton2_Click()

Dim fso As Object

strPath = "C:\Users\" & Environ("UserName") & "\Desktop\"
strFolderName = "Atskaites"
strFullPath = strPath & strFolderName & "\"

If Dir(strPath & strFolderName, vbDirectory) = "" Then
    MkDir strFullPath
End If

Set fso = CreateObject("Scripting.FileSystemObject") 'teksta faila izveidosana
Dim Fileout As Object
Set Fileout = fso.CreateTextFile(strFullPath & TextBox1.Text & ".txt", True, True)  'kur izveidot un kada formata    Fileout.Visible = True

Fileout.WriteLine "Klients:"
Fileout.WriteLine (TextBox1.Text)
Fileout.WriteLine "06.17"
Fileout.WriteLine (TextBox2.Text)
Fileout.WriteLine "07.17"
Fileout.WriteLine (TextBox3.Text)
Fileout.WriteLine "08.17"
Fileout.WriteLine (TextBox4.Text)
Fileout.WriteLine "09.17"
Fileout.WriteLine (TextBox5.Text)
Fileout.WriteLine "10.17"
Fileout.WriteLine (TextBox6.Text)
Fileout.WriteLine "Kopa"
Fileout.WriteLine (TextBox7.Text)

MsgBox ("Saved")

Fileout.Close

End Sub

1 个答案:

答案 0 :(得分:0)

有很多方法可以做到这一点。下面的示例代码只是一种方法。由于您说要保存一行数据,因此它首先要求您选择该行,然后询问要保存在哪个目录中,然后将该行复制到新工作簿中,最后将该工作簿另存为该目录中的文本文件。

当然,您需要针对特定​​情况进行修改。这只是为了让您开始尝试一些可行的方法。

Option Explicit
Sub saveRow()
Dim theDir As String
Dim sh As Worksheet, wk As Workbook, r As Range
Set r = Application.InputBox("select the row to export", , , Type:=8)
theDir = folderFromUser("C:/") 'C: is just the default location
Set wk = Workbooks.Add
r.Worksheet.Rows(r.row).Copy
ActiveSheet.Paste
wk.SaveAs theDir & "\test.txt", XlFileFormat.xlUnicodeText
Application.DisplayAlerts = False
wk.Close False
Application.DisplayAlerts = True
End Sub

Function folderFromUser(initialPath As String) As String
Dim fd As FileDialog, ButtonClickedByUser As Boolean, msg As String
On Error GoTo ErrorHandler
  Set fd = Application.FileDialog(msoFileDialogFolderPicker) 'see also msoFileDialogFilePicker
  fd.AllowMultiSelect = False
  fd.InitialFileName = Left(initialPath, InStrRev(initialPath, "\"))
  ButtonClickedByUser = fd.Show
  If ButtonClickedByUser = False Then Exit Function
  folderFromUser = fd.SelectedItems(1)
Exit Function
ErrorHandler:
MsgBox "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) _
  & Err.Description, , "Error in folderFromUser routine", Err.HelpFile, Err.HelpContext
Err.Clear
End Function