想实现功能:
1、另存为一个.csv后缀名的文件,并且保存在固定目录下。
2、判断这个文件是否存在,并且提示。程序如下 如何修改呢?Public sfind As String '定义全局变量,便于查找命令的实现
Dim edit As Boolean
Dim SaveFileName As StringPrivate Sub Form_Load()
RichTextBox1.Text = "" '窗体加载编辑框内容为空
 CommonDialog1.Filter = "DAT File *.dat| *.dat|Excel File *.csv| *.csv" 'Filter files, *.dat,*.csv only
 StatusBar1.Panels(5).Text = "TYPE:" & CommonDialog1.Filter
Timer1.Interval = 1
munnew.Enabled = False
    munfound.Enabled = False
    munfindnext.Enabled = False
    munlingc.Enabled = False
    munjianq.Enabled = False
    muncopy.Enabled = False
    mundelete.Enabled = False
    munxall.Enabled = False
If Clipboard.GetText() = "" Then
     numzhant.Enabled = False
     Else
     numzhant.Enabled = True
End If
   End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim i As String
If edit Then
 i = MsgBox("File Changed save or not?", vbYesNo + vbInformation, "Notice")
  If i = vbYes Then
   CommonDialog1.ShowSave
   RichTextBox1.SaveFile CommonDialog1.FileName, 1      '//这里是保存文件其中1表示保存为TXT
  End If
End If
End SubPrivate Sub mun_Click() '保存
Dim inputdata As String
If SaveFileName <> "" Then
 Open SaveFileName For Output As #1    Print #1, RichTextBox1.Text
    Close #1    Else
 CommonDialog1.CancelError = True '出错解决方法
    On Error GoTo ErrHandler  '出错解决方法
   CommonDialog1.ShowSave           '调出保存对话框
   FileType = CommonDialog1.FileTitle
      FiType = LCase(Right(FileType, 3))
      FileName = CommonDialog1.FileName
      Select Case FiType
      Case "dat"
      Case "csv"
      RichTextBox1.SaveFile FileName, rtfText
    End Select
ErrHandler:
End If
End SubPrivate Sub munabout_Click()
MsgBox "NanoSpec 3000 Data Reader CopyRight: Ambrosia Chan @ Littel Fuse 2011", , "NanoSpec Data Reader" '对话框
End Sub
Private Sub muncolor_Click()  '颜色
CommonDialog1.CancelError = True    '报错处理
    On Error GoTo ErrHandler           '报错处理
CommonDialog1.ShowColor               ' 调出颜色对话框
RichTextBox1.BackColor = CommonDialog1.Color         '背景颜色设置
ErrHandler:
End Sub
Private Sub muncopy_Click()
      Clipboard.Clear    '清空剪切板
      Clipboard.SetText RichTextBox1.SelText   '复制选中的内容
End SubPrivate Sub mundelete_Click()
 RichTextBox1.SelText = ""   '清空RichTextBox1选中的内容!
   
End SubPrivate Sub munexit_Click() '退出
Dim i As String
If edit Then
 i = MsgBox("File Changed save or not?", vbYesNoCancel + vbInformation, "Notice")
  If i = vbYes Then
   CommonDialog1.ShowSave
   RichTextBox1.SaveFile CommonDialog1.FileName, 1      '这里是保存文件其中1表示保存为TXT
   End
   ElseIf i = vbCancel Then
   Exit Sub
  ElseIf i = vbNo Then
   End
   Else
   End
  End If
End If
If edit = False Then
End
End IfEnd SubPrivate Sub munfindnext_Click()   '查找下一个
RichTextBox1.SelStart = RichTextBox1.SelStart + RichTextBox1.SelLength + 1 '继续查找下一个内容
RichTextBox1.Find sfind, , Len(RichTextBox1)
End SubPrivate Sub munfont_Click() '设置字体
CommonDialog1.CancelError = True      '报错处理
    On Error GoTo ErrHandler                     '报错处理
CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects     '设置字体对话框的样式
CommonDialog1.ShowFont
If CommonDialog1.FontName > "" Then
Form1.RichTextBox1.Font = CommonDialog1.FontName
End If
RichTextBox1.SelFontSize = CommonDialog1.FontSize
RichTextBox1.SelBold = CommonDialog1.FontBold
RichTextBox1.SelItalic = CommonDialog1.FontItalic
RichTextBox1.SelStrikeThru = CommonDialog1.FontStrikethru
RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
RichTextBox1.SelColor = CommonDialog1.Color
ErrHandler:
End SubPrivate Sub munfontcolor_Click()
CommonDialog1.CancelError = True         '报错处理
    On Error GoTo ErrHandler
CommonDialog1.ShowColor          '调出颜色对话框
RichTextBox1.SelColor = CommonDialog1.Color           '设置字体颜色
ErrHandler:                                      '结束报错
End SubPrivate Sub munfound_Click()
sfind = InputBox("Please input the keywords", "Find", sfind)     '查找输入框
      RichTextBox1.Find sfind                 '查找
End SubPrivate Sub munhelpzhut_Click()
frmtest.Show                        '调出窗体form2
End Sub
Private Sub munjianq_Click()
Clipboard.Clear                      '清空剪切板内容
      Clipboard.SetText RichTextBox1.SelText      ' 剪切选择内容
      RichTextBox1.SelText = ""
End SubPrivate Sub munlingc_Click()  '另存为对话框
CommonDialog1.CancelError = True
    On Error GoTo ErrHandler
CommonDialog1.ShowSave
    Open CommonDialog1.FileName For Output As #1
  Print #1, RichTextBox1.Text
   Close #1
ErrHandler:
End SubPrivate Sub munnew_Click()
Dim i As String
If edit Then
 i = MsgBox("File Changed save or not?", vbYesNo + vbInformation, "Notice")
  If i = vbYes Then
 CommonDialog1.CancelError = True
 On Error GoTo ErrHandler
 CommonDialog1.ShowSave
   RichTextBox1.SaveFile CommonDialog1.FileName, 1 '//这里是保存文件其中1表示保存为TXT
ErrHandler:
End If
End If
RichTextBox1.Text = ""
 End Sub
Private Sub munopen_Click()   '打开对话框
Dim i As String
If RichTextBox1.Text <> "" Then
 i = MsgBox("File Changed save or not?", vbYesNo + vbInformation, "Notice")
  If i = vbYes Then
  CommonDialog1.CancelError = True
    On Error GoTo ErrHandler
   CommonDialog1.ShowSave
   RichTextBox1.SaveFile CommonDialog1.FileName, rtfText       '//这里是保存文件其中1表示保存为TXT
     
     CommonDialog1.CancelError = True    '报错处理
   On Error GoTo ErrHandler
 CommonDialog1.ShowOpen  '打开对话框
 RichTextBox1.Text = ""       '清空文本框
    FileName = CommonDialog1.FileName   '文件路径
    RichTextBox1.LoadFile FileNameSaveFileName = CommonDialog1.FileName
ErrHandler:
Else
CommonDialog1.CancelError = True    '报错处理
   On Error GoTo ErrHandler
 CommonDialog1.ShowOpen
 RichTextBox1.Text = ""       '清空文本框
    FileName = CommonDialog1.FileName   '文件路径
    RichTextBox1.LoadFile FileNameSaveFileName = CommonDialog1.FileName
End IfElse
    CommonDialog1.CancelError = True    '报错处理
    On Error GoTo ErrHandler
 CommonDialog1.ShowOpen
  RichTextBox1.Text = ""       '清空文本框
      FileName = CommonDialog1.FileName   '文件路径
      RichTextBox1.LoadFile FileNameSaveFileName = CommonDialog1.FileName
End If
End SubPrivate Sub munprint_Click()
CommonDialog1.ShowPrinter   '打印
End SubPrivate Sub munxall_Click() '全选
RichTextBox1.SelStart = 0
RichTextBox1.SelLength = Len(RichTextBox1.Text)
End Sub
Private Sub numzhant_Click()
 RichTextBox1.SelText = Clipboard.GetText   '粘贴
 End Sub
Private Sub RichTextBox1_Change()
If RichTextBox1.Text = "" Then
munnew.Enabled = False
    mun.Enabled = False
    munfound.Enabled = False
    munfindnext.Enabled = False
    munlingc.Enabled = False
    munjianq.Enabled = False
    muncopy.Enabled = False
    mundelete.Enabled = False
    munxall.Enabled = False
Else
 munnew.Enabled = True
    mun.Enabled = True
    munfound.Enabled = True
    munfindnext.Enabled = True
    munlingc.Enabled = True
    numzhant.Enabled = True
    mundelete.Enabled = True
    munxall.Enabled = True
     munjianq.Enabled = True
    muncopy.Enabled = True
    End If
   
End SubPrivate Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)End SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)  '工具栏的设置
 Dim id
Select Case Button.Index
Case 1 '打开
    Call munopen_Click
Case 2       '新建
    Call munnew_Click
Case 3             '复制
    Call muncopy_Click
Case 4           ' 保存
    Call mun_Click
Case 5                         '剪切
      Call munjianq_Click
Case 6                        '粘贴
     Call numzhant_Click
    Case 7                              'Shell的调用,调出系统自带计算器
       id = Shell("C:\WINDOWS\system32\calc.exe", 1)
    Case 8                               'Shell的调用,调出系统自带浏览器并打开指定网址
        id = Shell("C:\Program Files\Internet Explorer\IEXPLORE.EXE http://wuxiweb/", 1)
        Case 9                            'Shell的调用,调出系统自带CMD.exe
        id = Shell("C:\WINDOWS\system32\cmd.exe", 1)
End Select
End Sub
 
      '设置编辑框的位置和大小
      Private Sub Form_Resize()
      On Error Resume Next         '出错处理
      RichTextBox1.Top = 600 '编辑框头部距上边框的距离
      RichTextBox1.Left = 50 '编辑框距左边窗体的距离
      RichTextBox1.Height = ScaleHeight - 1000 '编辑框距底部的距离
      RichTextBox1.Width = ScaleWidth - 100 '编辑框距宽度等于窗体的宽度-100
      End Sub
Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)  ' 鼠标右键快捷键
   If Button = 2 Then         '  单击左键时返回值为1,单击右键返回值为2!如果是2则是右键,调出菜单
      PopupMenu munedit         '  弹出菜单的设置项
   End If
   edit = True
End Sub
Private Sub Timer1_Timer()
Me.StatusBar1.Panels(2) = "Date:" & Now() ' 状态栏第二个窗格显示系统时间
End Sub

解决方案 »

  1.   

    1.RichTextBox1.SaveFile "d:\temp\temp.csv", 1
    2.if dir("d:\temp\temp.csv")="" then
          msgbox "文件已在在"
      end if
      

  2.   

    目的是每次打开一个固定的文件夹保存文件。比如从:c:/temp  如何实现呢?谢谢。
      

  3.   

    目的是每次打开一个固定的文件夹保存文件。比如从:c:/temp 如何实现呢?谢谢。
      

  4.   

    CommonDialog1.initdir= "你的目录 "