Consulting

Results 1 to 4 of 4

Thread: path as string.

  1. #1

    path as string.

    i am use access database with corel draw to print 1000 business card in 5 minutes with print merge command in corel draw. i am running successfully with text but for images it is showing only its file path location where i stored the "jpg" files.
    i have folder which contain the "jpg" of employees. when i use print merge command of corel draw in picture box. it is showing only path not the jpg of the employee based on unique id.
    please help me to build the VBA code for vb editor.


  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    We need to see your existing code
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    Option Explicit
    
    Private Const BIF_STATUSTEXT = 4
    Private Const BIF_RETURNONLYFSDIRS = 1
    Private Const BIF_DONTGOBELOWDOMAIN = 2
    Private Const BIF_EDITBOX As Integer = &H10
    Private Const BIF_NEWDIALOGSTYLE As Integer = &H20
    Private Const BIF_USENEWUI As Integer = &H40
    
    
    Private Const MAX_PATH = 260
    
    
    Private Const WM_USER = &H400
    Private Const BFFM_INITIALIZED = 1
    Private Const BFFM_SELCHANGED = 2
    Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
    Private Const BFFM_SETSELECTION = (WM_USER + 102)
    
    
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
    Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BrowseInfo) As Long
    Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
    Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
    Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
    
    
    Private Type BrowseInfo
        hWndOwner      As Long
        pIDLRoot       As Long
        pszDisplayName As Long
        lpszTitle      As Long
        ulFlags        As Long
        lpfnCallback   As Long
        lParam         As Long
        iImage         As Long
    End Type
    
    
    Private m_CurrentDirectory As String   'The current directory
    
    
    Public Function BrowseForFolder(ByVal hWnd As Long, ByVal Title As String, ByVal StartDir As String) As String
        Dim lpIDList As Long
        Dim szTitle As String
        Dim sBuffer As String
        Dim tBrowseInfo As BrowseInfo
        
        m_CurrentDirectory = StartDir & vbNullChar
        
        szTitle = Title
        With tBrowseInfo
            .hWndOwner = hWnd
            .lpszTitle = lstrcat(szTitle, "")
            .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT + BIF_USENEWUI
            .lpfnCallback = GetAddressOfFunction(AddressOf BrowseCallbackProc)
        End With
        
        lpIDList = SHBrowseForFolder(tBrowseInfo)
        If lpIDList Then
            sBuffer = Space$(MAX_PATH)
            SHGetPathFromIDList lpIDList, sBuffer
            sBuffer = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
            BrowseForFolder = sBuffer
            CoTaskMemFree lpIDList
        Else
            BrowseForFolder = ""
        End If
        
    End Function
     
    Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
        Dim lpIDList As Long
        Dim ret As Long
        Dim sBuffer As String
        
        On Error Resume Next    'Sugested by MS to prevent an error from
                                'propagating back into the calling process.
        Select Case uMsg
            Case BFFM_INITIALIZED
                SendMessage hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory
        
            Case BFFM_SELCHANGED
                sBuffer = Space$(MAX_PATH)
                
                ret = SHGetPathFromIDList(lp, sBuffer)
                If ret = 1 Then
                    SendMessage hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer
                End If
        End Select
        
        BrowseCallbackProc = 0
    End Function
    
    
    Private Function GetAddressOfFunction(add As Long) As Long
        GetAddressOfFunction = add
    End Function

  4. #4

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •