首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

一个关于VB另存为的有关问题

2012-01-20 
一个关于VB另存为的问题想实现功能:1、另存为一个.csv后缀名的文件,并且保存在固定目录下。2、判断这个文件是

一个关于VB另存为的问题
想实现功能:
1、另存为一个.csv后缀名的文件,并且保存在固定目录下。
2、判断这个文件是否存在,并且提示。

程序如下 如何修改呢?

Public sfind As String '定义全局变量,便于查找命令的实现
Dim edit As Boolean
Dim SaveFileName As String

Private 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 Sub

Private 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 Sub

Private 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 Sub

Private 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 Sub



Private Sub mundelete_Click()
 RichTextBox1.SelText = "" '清空RichTextBox1选中的内容!
   
End Sub

Private 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 If

End Sub



Private Sub munfindnext_Click() '查找下一个
RichTextBox1.SelStart = RichTextBox1.SelStart + RichTextBox1.SelLength + 1 '继续查找下一个内容
RichTextBox1.Find sfind, , Len(RichTextBox1)
End Sub

Private 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 Sub

Private Sub munfontcolor_Click()
CommonDialog1.CancelError = True '报错处理
  On Error GoTo ErrHandler
CommonDialog1.ShowColor '调出颜色对话框
RichTextBox1.SelColor = CommonDialog1.Color '设置字体颜色
ErrHandler: '结束报错
End Sub

Private Sub munfound_Click()
sfind = InputBox("Please input the keywords", "Find", sfind) '查找输入框
  RichTextBox1.Find sfind '查找
End Sub

Private Sub munhelpzhut_Click()
frmtest.Show '调出窗体form2
End Sub


Private Sub munjianq_Click()
Clipboard.Clear '清空剪切板内容
  Clipboard.SetText RichTextBox1.SelText ' 剪切选择内容
  RichTextBox1.SelText = ""
End Sub

Private 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 Sub

Private 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 FileName

SaveFileName = CommonDialog1.FileName
ErrHandler:
Else
CommonDialog1.CancelError = True '报错处理
  On Error GoTo ErrHandler
 CommonDialog1.ShowOpen
 RichTextBox1.Text = "" '清空文本框
  FileName = CommonDialog1.FileName '文件路径
  RichTextBox1.LoadFile FileName

SaveFileName = CommonDialog1.FileName
End If

Else
  CommonDialog1.CancelError = True '报错处理
  On Error GoTo ErrHandler
 CommonDialog1.ShowOpen
  RichTextBox1.Text = "" '清空文本框
  FileName = CommonDialog1.FileName '文件路径
  RichTextBox1.LoadFile FileName

SaveFileName = CommonDialog1.FileName
End If
End Sub

Private Sub munprint_Click()
CommonDialog1.ShowPrinter '打印
End Sub



Private 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 Sub

Private Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)

End Sub

Private 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.RichTextBox1.SaveFile "d:\temp\temp.csv", 1
2.if dir("d:\temp\temp.csv")="" then
msgbox "文件已在在"
end if

[解决办法]

探讨

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

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

热点排行