?
Solved

.jpg file in image software

Posted on 2001-09-01
8
Medium Priority
?
532 Views
Last Modified: 2012-08-13
how can i open a .jpg file (which displayed in picture box or image control) on double clicking to open in this file in photoshop or paintbrush etc. and after edit the file back to vb form .
0
Comment
Question by:sar1478
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
8 Comments
 
LVL 4

Accepted Solution

by:
wileecoy earned 200 total points
ID: 6448413
The basic premise is that you use the file association in windows (found in the registry) to open the default application and load the jpg.

Then, after saving and closing the application (probably a shell command and wait for completion) you would simply reload the jpg file and it would reload the updated file.

Another option would be to double click on it and offer the user the "Open With" windows dialog box and let them select what application to use.  It might also be easier to load the file.

If this is the type of solution you are looking for, just hell and I will see what I can do.

hth.

Wileecoy.
0
 
LVL 4

Expert Comment

by:wileecoy
ID: 6448519
Okay - I didn't wait for you to let me know if that is what you wanted.  It interesting - so here it is.

Save the text from the following message into a file and name it "WhatEverYouWant.frm".

Start a new standard project.
Add components:
1.  Windows Common Dialog Controls
2.  Windows Common Controls

Remove the existing empty form (Form1)
Add the "WhatEverYouWant.frm"
press F5 - you will get an error about the startup.
Change the startup to your form in the dialog box that pops up with the error.

There are instructions on a label on the form.

It works on mine - hope it works on yours.

0
 
LVL 4

Expert Comment

by:wileecoy
ID: 6448520
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmAssoUtil
   Caption         =   "File Association Utility"
   ClientHeight    =   8832
   ClientLeft      =   1140
   ClientTop       =   1500
   ClientWidth     =   7692
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   8832
   ScaleWidth      =   7692
   Begin VB.PictureBox Picture1
      Height          =   2136
      Left            =   144
      ScaleHeight     =   2088
      ScaleWidth      =   7380
      TabIndex        =   12
      Top             =   2520
      Width           =   7428
   End
   Begin MSComctlLib.ListView lvwAsso
      Height          =   3960
      Left            =   108
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   4788
      Width           =   7488
      _ExtentX        =   13208
      _ExtentY        =   6985
      View            =   3
      LabelEdit       =   1
      Sorted          =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.CommandButton Command2
      Caption         =   "Find JPG"
      Height          =   300
      Left            =   6588
      TabIndex        =   9
      Top             =   2160
      Width           =   876
   End
   Begin VB.CommandButton Command1
      Caption         =   "Open Application"
      Height          =   300
      Left            =   4212
      TabIndex        =   8
      Top             =   1188
      Width           =   3252
   End
   Begin VB.TextBox Text1
      Height          =   288
      Index           =   3
      Left            =   108
      TabIndex        =   7
      Top             =   2160
      Width           =   6456
   End
   Begin VB.TextBox Text1
      Enabled         =   0   'False
      Height          =   288
      Index           =   2
      Left            =   108
      TabIndex        =   6
      Top             =   1656
      Width           =   7356
   End
   Begin VB.TextBox Text1
      Enabled         =   0   'False
      Height          =   288
      Index           =   1
      Left            =   2160
      TabIndex        =   5
      Top             =   1188
      Width           =   2028
   End
   Begin VB.TextBox Text1
      Enabled         =   0   'False
      Height          =   288
      Index           =   0
      Left            =   108
      TabIndex        =   4
      Top             =   1188
      Width           =   2028
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   72
      Top             =   2412
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdExit
      Caption         =   "Exit"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1260
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   72
      Width           =   1005
   End
   Begin VB.CommandButton cmdList
      Caption         =   "List"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   108
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   72
      Width           =   1005
   End
   Begin VB.Label lblMessage
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   216
      Left            =   2592
      TabIndex        =   11
      Top             =   108
      Width           =   60
   End
   Begin VB.Label Label1
      Caption         =   "Enter path of JPG file below, or find by clicking ""Find JPG"" button to the right."
      Height          =   264
      Left            =   108
      TabIndex        =   10
      Top             =   1944
      Width           =   7392
   End
   Begin VB.Label lblProgress
      Caption         =   "In progress...."
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   108
      TabIndex        =   3
      Top             =   864
      Width           =   2016
   End
End
Attribute VB_Name = "frmAssoUtil"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' AssoUtil.frm
'
' By Herman Liu
'
' Adapted By Norm Floria
'
Option Explicit

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type SecurityAttributes
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As Long) As Long
   
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
    lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
    lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
   
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal mkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
   
Private Declare Function RegEnumValueType Lib "advapi32.dll" Alias "RegEnumValueA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
    ByVal null1 As Long, ByVal null2 As Long) As Long
   
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, _
    lpcbData As Long) As Long
   
Private Declare Function RegEnumValueString Lib "advapi32.dll" Alias "RegEnumValueA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As String, _
    lpcbData As Long) As Long
       
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_LOCAL_MACHINE = &H80000002

  ' Reg key security attribute
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_SET_VALUE = &H2&
Private Const KEY_ALL_ACCESS = &H3F
Private Const KEY_CREATE_SUBKEY = &H4&
Private Const KEY_ENUMERATE_SUBKEY = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const KEY_CREATE_LINK = &H20
Private Const READ_CONTROL = &H20000
Private Const WRITE_OWNER = &H80000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
      KEY_ENUMERATE_SUBKEY Or KEY_NOTIFY
Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUBKEY

   ' Data types
Private Const REG_NONE = 0
Private Const REG_SZ = 1                 ' Unicode null terminated string
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3             ' Binary
Private Const REG_DWORD = 4              ' 32-bit number
Private Const REG_DWORD_LITTLE_ENDIAN = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_LINK = 6
Private Const REG_MULTI_SZ = 7
Private Const REG_RESOURCE_LIST = 8
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10

Private Const OPTION_NON_VOLATILE = &H0    ' Info is stored in a file and is preserved

Private Const MainKey = HKEY_LOCAL_MACHINE
Private Const SubKey = "SOFTWARE\Classes"
Private Const ShellSubKey = "Shell\Open\Command"

Dim mLVIndex As Integer
Dim mStage As Integer
Dim mStopFlag As Boolean
Dim mresult
Private Const ERROR_SUCCESS = 0&

Private Sub Command1_Click()
    Dim FilePath() As String
    Dim sPath As String
    FilePath = Split(Text1(2).Text, "%1", -1, vbTextCompare)
    sPath = Left(FilePath(0), Len(FilePath(0)) - 3) & """ """ & Text1(3).Text & """"
    ShellAndWait (sPath)
    Picture1.Picture = LoadPicture(Text1(3).Text)
End Sub

Private Sub Command2_Click()
     On Error GoTo errhandler
     Dim gcdg As Object
     Set gcdg = CommonDialog1
     gcdg.Filter = "(*.jpg Picture Files)|*.jpg|(*.*)|*.*|"
     gcdg.FilterIndex = 1
     gcdg.DefaultExt = "jpg"
     gcdg.Flags = cdlOFNFileMustExist
     gcdg.FileName = ""
     gcdg.CancelError = True
     gcdg.ShowOpen
     If gcdg.FileName = "" Then
         Exit Sub
     End If
     Text1(3).Text = gcdg.FileName
     Picture1.Picture = LoadPicture(Text1(3).Text)
     Exit Sub
   
errhandler:
     If Err <> 32755 Then
         MsgBox "cmdDialogFileSpec_Click"
     End If
End Sub

Private Sub Form_Load()
     ' Configure ListView control.
    lvwAsso.ListItems.Clear
    lvwAsso.ColumnHeaders.Clear
    lvwAsso.ColumnHeaders.Add , , "Ext", 1000
    lvwAsso.ColumnHeaders.Add , , "Title Ref", (3000)
    lvwAsso.ColumnHeaders.Add , , "Association", (Me.Width - 4200)
    lvwAsso.LabelEdit = lvwManual
    lvwAsso.FullRowSelect = True
    lvwAsso.HideSelection = False
    lvwAsso.HideColumnHeaders = False
    lvwAsso.View = lvwReport
    lblProgress.Visible = False
   
    lblMessage = "1. Press 'List' Button" & vbCrLf & _
                 "2. Double-Click the 'JPG' format in the listview" & vbCrLf & _
                 "3. Enter the path of the JGP file or press 'Find JPG' button." & vbCrLf & _
                 "4. Press 'Open Application' Button"
   
   
End Sub
Private Sub cmdList_Click()
    Dim mlistitem As ListItem
    Dim colSubKeys As Collection
    Dim arrAsso() As String
    Dim mkey As Long
    Dim mBuffer As String * 256
    Dim mBufSize As Long
    Dim mClassBuffer As String
    Dim mClassBufSize As Long
    Dim typLastWriteTime As FILETIME
    Dim SubKeyName As String
    Dim SubKeyValue As String
    Dim mValType As Long
    Dim mIndex As Integer
    Dim mKeyRef As String
    Dim mCtn As Integer
    Dim mHasOne As Boolean
    Dim mPercent As Integer
    Dim tmp As String, mChr As String
    Dim i As Integer, j As Integer
   
    Set colSubKeys = New Collection
   
    If RegOpenKeyEx(MainKey, SubKey, 0&, KEY_ALL_ACCESS, mkey) <> 0& Then
        Exit Sub
    End If

    lvwAsso.Visible = True
    lblProgress.Visible = True
    DoEvents
    Screen.MousePointer = vbHourglass
    mStopFlag = False
   
       ' Enumerate the Subkey's colSubKeys
    mIndex = 0
    Do
        mClassBuffer = ""
        mClassBufSize = 0
        mBufSize = 256
        SubKeyName = Space$(mBufSize)
        mresult = RegEnumKeyEx(mkey, mIndex, SubKeyName, mBufSize, 0, mClassBuffer, _
                mClassBufSize, typLastWriteTime)
        If mresult <> 0& And mresult <> 234 Then
            If Left(SubKeyName, 10) = "          " Then
                Exit Do
            End If
        End If
        SubKeyName = Left$(SubKeyName, InStr(SubKeyName, Chr$(0)) - 1)
        If Left$(SubKeyName, 1) = "." Then
             colSubKeys.Add SubKeyName
        End If
        mIndex = mIndex + 1
    Loop
       
    lvwAsso.ListItems.Clear
       ' Recursively get information on the keys.
    For i = 1 To colSubKeys.Count
        ListEntryValues0 MainKey, SubKey & "\" & colSubKeys(i)
    Next i
    RegCloseKey mkey
   
    mCtn = lvwAsso.ListItems.Count
    lblProgress.Visible = False
    If mCtn = 0 Then
         Screen.MousePointer = vbDefault
         MsgBox "No file association found"
         Exit Sub
    End If
   
       ' Fill commands in Listview.
       ' We start from 1 as ListItems is 1-based
    For i = 1 To mCtn
         mKeyRef = lvwAsso.ListItems(i).SubItems(1)
         mLVIndex = i
         DoEnumSubKeys MainKey, SubKey & "\" & mKeyRef & "\" & ShellSubKey
    Next i
   
       ' Check and delete those items without a command, if any
    ReDim arrAsso(mCtn - 1, 2)
    mHasOne = False
    For i = 1 To mCtn
         If Len(Trim(lvwAsso.ListItems(i).SubItems(2))) > 0 Then
              arrAsso(i - 1, 0) = lvwAsso.ListItems(i).Text
              arrAsso(i - 1, 1) = lvwAsso.ListItems(i).SubItems(1)
              arrAsso(i - 1, 2) = lvwAsso.ListItems(i).SubItems(2)
         Else
              mHasOne = True
         End If
    Next i
    If mHasOne Then
         lvwAsso.ListItems.Clear
         For i = 0 To UBound(arrAsso)
             If Len(Trim(arrAsso(i, 2))) > 0 Then
                   Set mlistitem = lvwAsso.ListItems.Add(, , Text:=arrAsso(i, 0))
                   mlistitem.SubItems(1) = arrAsso(i, 1)
                   mlistitem.SubItems(2) = arrAsso(i, 2)
             End If
         Next i
    End If
    mCtn = lvwAsso.ListItems.Count
   
    lblProgress.Visible = False
    Screen.MousePointer = vbDefault
    If mCtn > 0 Then
         MsgBox "Listing completed.  Total  " & CStr(mCtn)
           ' Let hightlight visible
         If Not Me.WindowState = 1 Then
              lvwAsso.SetFocus
         End If
    Else
         MsgBox "No file association found"
    End If
End Sub

Private Sub DoEnumSubKeys(ByVal inMainKey As Long, ByVal inSubKey As String)
    Dim mkey As Long
    Dim colSubKeys As Collection
    Dim colSubKeyValues As Collection
   
    Dim mBuffer As String * 256
    Dim mBufSize As Long
    Dim mClassBuffer As String * 256
    Dim mClassBufSize As Long
    Dim typLastWriteTime As FILETIME
   
    Dim SubKeyName As String
    Dim SubKeyValue As String
    Dim mValType As Long
    Dim mIndex As Integer
    Dim i As Integer
    Dim tmp As String, mChr As String
   
    Dim Ok As Boolean
   
    Set colSubKeys = New Collection
   
    If RegOpenKeyEx(inMainKey, inSubKey, 0&, KEY_ALL_ACCESS, mkey) <> 0& Then
        mStopFlag = True
        Exit Sub
    End If

    tmp = ""
    For i = Len(inSubKey) To 1 Step -1
        mChr = Mid(inSubKey, i, 1)
        If mChr = "\" Then
            Exit For
        End If
        tmp = mChr & tmp
    Next i
   
    ListEntryValues1 inMainKey, inSubKey
   
       ' Enumerate the Subkey's colSubKeys
    mIndex = 0
    Do
        mClassBuffer = ""
        mClassBufSize = 0
        mBufSize = 256
        SubKeyName = Space$(mBufSize)
        mresult = RegEnumKeyEx(mkey, mIndex, SubKeyName, mBufSize, 0, mClassBuffer, _
                mClassBufSize, typLastWriteTime)
        If mresult <> 0& Then
             Exit Do
        End If
        SubKeyName = Left$(SubKeyName, InStr(SubKeyName, Chr$(0)) - 1)
        If Len(Trim(SubKeyName)) > 0 Then
             colSubKeys.Add SubKeyName
        End If
        mIndex = mIndex + 1
    Loop
    RegCloseKey mkey
       
       ' Recursively get information on the keys.
    For i = 1 To colSubKeys.Count
        If mStopFlag Then
             Exit Sub
        End If
        DoEnumSubKeys inMainKey, inSubKey & "\" & colSubKeys(i)
    Next i
End Sub

Private Sub ListEntryValues0(ByVal inMainKey As Long, ByVal inSubKey As String)
    Dim mkey
    Dim mEntry As String
    Dim mEntryLength As Long
    Dim mDataType As Long
    Dim arrDataByte(1 To 1024) As Byte
    Dim mDataByteLength As Long
    Dim mDataByteValue As String
    Dim i As Integer
    Dim mIndex As Integer
    Dim NetSubKey As String, mChr As String
    Dim mlistitem As ListItem
   
    mresult = RegOpenKeyEx(inMainKey, inSubKey, 0&, KEY_ALL_ACCESS, mkey)
    If mresult <> 0 Then
        Exit Sub
    End If
   
    NetSubKey = ""
    For i = Len(inSubKey) To 1 Step -1
        mChr = Mid(inSubKey, i, 1)
        If mChr = "\" Then
            Exit For
        End If
        NetSubKey = mChr & NetSubKey
    Next i
    mIndex = 0
    'Here is where you would add an if statment to only continue if
    '  NetSubKey is the file type (extension) that you want to find.
    '  ex: If lcase(NetSubKey) = ".jpg" then
    '          Do
    '              mEntryLength = 1024... etc
    Do
        mEntryLength = 1024
        mDataByteLength = 1024
        mEntry = Space$(mEntryLength)
        mresult = RegEnumValue(mkey, mIndex, mEntry, mEntryLength, 0, _
           mDataType, arrDataByte(1), mDataByteLength)
        If mresult <> 0 Then                  ' No more
            Exit Do
        End If

        mEntry = Left$(mEntry, mEntryLength)
          ' Note if value is "(No value set)" then the following
          ' will not be displayed, i.e. as if no entry exists.
        If mEntry = "" And mDataByteLength > 0 Then            ' (Default)
             If mDataType = REG_SZ Then
                  mDataByteValue = ""
                  For i = 1 To mDataByteLength - 1
                        mDataByteValue = mDataByteValue & Chr$(arrDataByte(i))
                  Next i
                  If Trim(mDataByteValue) <> "" Then
                        Set mlistitem = lvwAsso.ListItems.Add(, , Text:=NetSubKey)
                        mlistitem.SubItems(1) = mDataByteValue
                  End If
             End If
             Exit Do
        End If
        mIndex = mIndex + 1
    Loop
    RegCloseKey mkey
End Sub

Private Sub ListEntryValues1(ByVal inMainKey As Long, ByVal inSubKey As String)
    Dim mkey As Long
    Dim mEntry As String
    Dim mEntryLength As Long
    Dim mDataType As Long
    Dim arrDataByte(1 To 1024) As Byte
    Dim mDataByteLength As Long
    Dim mDataByteValue As String
    Dim i As Integer
    Dim mIndex As Integer
   
    mresult = RegOpenKeyEx(inMainKey, inSubKey, 0&, KEY_ALL_ACCESS, mkey)
    If mresult <> 0 Then
        Exit Sub
    End If
   
    mIndex = 0
    mEntryLength = 1024
    mDataByteLength = 1024
    mEntry = Space$(mEntryLength)
    mresult = RegEnumValue(mkey, mIndex, mEntry, mEntryLength, 0, _
          mDataType, arrDataByte(1), mDataByteLength)
    If mresult <> 0 Then                  ' No more
        Exit Sub
    End If

    mEntry = Left$(mEntry, mEntryLength)
          ' Note if value is "(No value set)" then the following
          ' will not be displayed, i.e. as if no entry exists.
    If mEntry = "" And mDataByteLength > 0 Then            ' (Default)
         If mDataType = REG_SZ Then
              mDataByteValue = ""
              For i = 1 To mDataByteLength - 1
                    mDataByteValue = mDataByteValue & Chr$(arrDataByte(i))
              Next i
              If Trim(mDataByteValue) <> "" Then
                    lvwAsso.ListItems(mLVIndex).SubItems(2) = mDataByteValue
              Else
                    lvwAsso.ListItems(mLVIndex).SubItems(2) = ""
              End If
         End If
    End If
    RegCloseKey mkey
End Sub

' Here we resize lvwAsso and picProgressContainer only
Private Sub Form_Resize()
    Dim h As Single, w As Single
       ' Avoid runtime error
    h = Me.ScaleHeight - lvwAsso.Top
    If h < 150 Then
         h = 150
    End If
    lvwAsso.Move 0, lvwAsso.Top, Me.ScaleWidth, h
    w = (lvwAsso.ColumnHeaders(1).Width + lvwAsso.ColumnHeaders(2).Width + 200)
    If Me.Width > w Then
        lvwAsso.ColumnHeaders(3).Width = (Me.Width - w)
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdCancel_Click()
    lvwAsso.Visible = True
End Sub

Private Function GetRegEntry(ByVal inMainKey As Long, ByVal inSubKey As String, ByVal inEntry As String) As String
    Dim mkey As Long
    Dim mBuffer As String * 255
    Dim mBufSize As Long
    mresult = RegOpenKeyEx(inMainKey, inSubKey, 0, KEY_READ, mkey)
    If mresult = 0 Then
          mBufSize = Len(mBuffer)
          mresult = RegQueryValueEx(mkey, inEntry, 0, REG_SZ, mBuffer, mBufSize)
          If mresult = 0 Then
                If mBuffer <> "" Then
                     GetRegEntry = Mid$(mBuffer, 1, mBufSize)
                End If
                RegCloseKey mkey
          Else                    ' Value may be simply not exist, not an error
                GetRegEntry = ""
          End If
    Else
          MsgBox "Unable to open " & inSubKey
          GetRegEntry = ""
    End If
End Function

'**************************************
' Name: Best Shell & Wait (No API's!)
' By: Matt Roberts
'
' Inputs:FileName - The name of the file
'     you wish to run with any required switch
'     es included.
'
' Returns:True if the file was run and
'     returned.
'False If there was a file open or save error.
'EXAMPLE: ShellAndWait ("notepad.exe c:\temp\teset.txt)
'

Function ShellAndWait(FileName As String)
    Dim objScript
    Dim shellapp
    On Error GoTo ERR_OpenForEdit
    Set objScript = CreateObject("WScript.Shell")
        shellapp = objScript.Run(FileName, 1, True)
        ShellAndWait = True
EXIT_OpenForEdit:
        Exit Function
ERR_OpenForEdit:
        MsgBox Err.Number & Err.Description
        GoTo EXIT_OpenForEdit
    End Function
Private Sub lvwAsso_DblClick()
    Text1(0).Text = lvwAsso.SelectedItem.Text
    Text1(1).Text = lvwAsso.SelectedItem.SubItems(1)
    Text1(2).Text = lvwAsso.SelectedItem.SubItems(2)
End Sub
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:sar1478
ID: 6448617
Can you povide sample or example working application.
0
 
LVL 4

Expert Comment

by:wileecoy
ID: 6448824
The above code is a working application.

Follow the instructions in my second previous comment, and copy and paste the code in my first previous comment, and you should have a form with all the code.

Let me know what kind of problems you are having.  If it is bad enough, I could e-mail the code to you, I guess.

Wileecoy.
0
 

Author Comment

by:sar1478
ID: 6454162
dear wileecoy

please mail me the working code.
 my mail address is viv2575@hotmail.com
0
 
LVL 49

Expert Comment

by:DanRollins
ID: 7205372
Hi sar1478,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Accept wileecoy's comment(s) as an answer.

sar1478, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you.  DO NOT accept this comment as an answer.

EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer
0
 
LVL 5

Expert Comment

by:Netminder
ID: 7240863
Per recommendation, force-accepted.

Netminder
CS Moderator
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

719 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question