Office中国论坛/Access中国论坛

标题: [求助]用什么代码可以打开E盘？ [打印本页]

作者: 好学 时间: 2007-3-18 04:36
标题: [求助]用什么代码可以打开E盘？
假设光驱是E盘，用什么代码可以打开E盘？看到E盘的内容？

作者: 一点通 时间: 2007-3-18 06:02
在按钮的"超链接地址"中写入E:\

[此贴子已经被作者于2007-3-17 22:02:00编辑过]

作者: 好学 时间: 2007-3-18 06:35
但如果要做成安装软件的光盘中的浏览光盘内容，这样的效果，就是打开当前的驱动器，那应该如何呢？谢谢！

[此贴子已经被作者于2007-3-17 22:37:43编辑过]

作者: nxjswt 时间: 2007-3-18 06:43
例如

建立个函数

Option Compare Database
Option Explicit
Dim path As String

Sub getFileName()
' 显示一个 Office 打开文件对话框，为当前的雇员记录
' 选择一个文件名．如果用户选择了一个文件，
' 则将它显示到图片控件中
Dim fileName As String
Dim result As Integer
With Application.FileDialog(msoFileDialogFilePicker)
      .Title = "选择雇员照片"
      .Filters.Add "所有文件", "*.*"
      .Filters.Add "JPEGs", "*.jpg"
      .Filters.Add "位图文件", "*.bmp"
      .FilterIndex = 3
      .AllowMultiSelect = False
      .InitialFileName = CurrentProject.path
      result = .Show
      If (result <> 0) Then
         fileName = Trim(.SelectedItems.Item(1))
         Me![照片路径].Visible = True
         Me![照片路径].SetFocus
         Me![照片路径].Text = fileName
         Me![姓氏].SetFocus
         Me![照片路径].Visible = False
         错误信息.Visible = False
      End If
End With
End Sub

然后调用

Private Sub 添加照片_Click()
' 使用 Office 文件打开对话框

getFileName
End Sub

作者: 好学 时间: 2007-3-18 07:27
大哥，你可能理解错我的意思了，不是打开对话框选择文件，我是要做成软件安装时浏览光盘内容的按钮。是要打开当前光驱的内容。光驱每台机都可以是不同的名（如：E、H、F.....都有可能).

作者: 好学 时间: 2007-3-18 08:21
确切应该这样说吧，用什么代码可以打开我的电脑，并且到了文件的当前目录。

作者: 一点通 时间: 2007-3-18 08:35
建一个列表框(Combo1),在值列表中写入全部的盘符(C;D;E;F;G;H),在按钮(Command0)的单击事件中写入如下代码

Me.Command0.HyperlinkAddress = Me.Combo1 & ":\"

在列表框中选中盘符,再按按钮就可打开对应的盘

作者: 好学 时间: 2007-3-18 18:36
我是在VB写这个代码的,是这样吗?但不行[em06][em06][em06]

Command0.HyperlinkAddress = App.Path & ":\"

作者: 好学 时间: 2007-3-19 02:02
一点通领导可以帮帮我吗？谢谢了！

作者: fan0217 时间: 2007-3-19 03:13
获取光盘盘符：

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6

'获取光驱盘符
Public Function GetCDROMDrive() As String
Dim r    As Long
Dim allDrives    As String
Dim currDrive    As String
Dim drvType    As Integer

allDrives = GetDriveString()
      Do Until allDrives = Chr$(0)
         currDrive = StripNulls(allDrives)
         drvType = GetDriveType(currDrive)
         If drvType = DRIVE_CDROM Then
            GetCDROMDrive = currDrive
            Exit Do
         End If
      Loop
End Function

Private Function GetDriveString() As String
Dim sBuffer As String
      sBuffer = Space$(26 * 4)
      If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then
         GetDriveString = Trim$(sBuffer)
      End If
End Function

Private Function StripNulls(startstr As String) As String
Dim pos    As Long
pos = InStr(startstr$, Chr$(0))
If pos Then
      StripNulls = Mid$(startstr, 1, pos - 1)
      startstr = Mid$(startstr, pos + 1, Len(startstr))
End If
End Function

[此贴子已经被作者于2007-3-18 19:14:17编辑过]

作者: 好学 时间: 2007-3-19 04:15
fan0217大哥是这样打开吗?但为什么不行呢?

Private Sub 浏览_Click()
Call GetCDROMDrive
End Sub

作者: andymark 时间: 2007-3-19 04:45
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Const DRIVE_CDROM = 5

Public Function GetCDRom() As String

Dim rtn As String
Dim AllDrives As String
Dim JustOneDrive As String

AllDrives = Space$(64) '设置缓冲

rtn = GetLogicalDriveStrings(Len(AllDrives), AllDrives) '调用函数得到包含所有驱动器的字符串

AllDrives = Left(AllDrives, rtn)

Do
  rtn = InStr(AllDrives, Chr(0))
  If rtn Then                                     '若有的话
   JustOneDrive = Left(AllDrives, rtn)
   AllDrives = Mid(AllDrives, rtn + 1, Len(AllDrives))
   rtn = GetDriveType(JustOneDrive)             '检查驱动器类型
   If rtn = DRIVE_CDROM Then                      '是CD-ROM
      GetCDRom = Left(UCase(JustOneDrive), 2)
      Exit Do
   End If
  End If
Loop Until AllDrives = "" Or rtn = DRIVE_CDROM

If GetCDRom = "" Then
MsgBox "没有光驱"
Else
Call ShellExecute(hwnd, "Open", "", "", GetCDRom, 1)
End If

End Function

[此贴子已经被作者于2007-3-18 20:48:50编辑过]

作者: 好学 时间: 2007-3-19 04:51
可以了!谢谢两位版主![em17][em17][em17]

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)