retrieve directory + file from listbox

Hi,

I have a listbox in excel form (vba) which you can see in the code below
As the list is multi select enable I would like to be able to retrieve each directory + filename in a string.

As I want to print it to pdf with following code:

--------------------------------------------------------
Private Sub CommandButton4_Click()
 
Dim sDocFile As String
Dim sPDFFile As String

'Change the path to whatever you want it to be.
sDocFile = "Z:\Templates\be-nl\Offerte Cimtech Filter.doc"
 
Call DOC2PDF(sDocFile, sPDFFile) 'Note: sPDFFile is optional
 
End Sub
--------------------------------------------------------

As you can see the sDocFile should be in a for each loop.
But how? :)
Private Sub CommandButton3_Click()
    Dim fileList() As String
    Dim fName As String
    Dim fPath As String
    Dim I As Integer
    Me.ListBox1.Clear
     'define the directory to be searched for files
    fPath = "Z:\Templates\fr-fr\Offres + transport\"
     
     'build a list of the files
    fName = Dir(fPath & "*.doc")
    While fName <> ""
         'add fName to the list
        I = I + 1
        ReDim Preserve fileList(1 To I)
        fileList(I) = fName
         'get next filename
        fName = Dir()
    Wend
     'see if any files were found
    If I = 0 Then
         MsgBox "No files found"
        Exit Sub
    End If
     'cycle through the list and add to listbox
    For I = 1 To UBound(fileList)
        Me.ListBox1.AddItem fileList(I)
    Next
End Sub

Open in new window

LVL 3
MutsopAsked:
Who is Participating?
 
CSecurityConnect With a Mentor Commented:

Private Sub CommandButton4_Click()
 
Dim sDocFile As String
Dim sPDFFile As String
Dim i as Long

For i = 0 to ListBox1.ListCount -1
sDocFile = ListBox1.List(i)

Call DOC2PDF(sDocFile, sPDFFile) 'Note: sPDFFile is optional

next i
 
End Sub

Open in new window

0
 
CSecurityCommented:

Private Sub CommandButton3_Click()
    Dim fileList() As String
    Dim fName As String
    Dim fPath As String
    Dim I As Integer
    Dim sDocFile As String
    Dim sPDFFile As String
    Me.ListBox1.Clear
     'define the directory to be searched for files
    fPath = "Z:\Templates\fr-fr\Offres + transport\"
     
     'build a list of the files
    fName = Dir(fPath & "*.doc")
    While fName <> ""
         'add fName to the list
        I = I + 1
        ReDim Preserve fileList(1 To I)
        fileList(I) = fName
      	sDocFile = "Z:\Templates\be-nl\" & fName
 	Call DOC2PDF(sDocFile, sPDFFile)
        fName = Dir()
    Wend
   
    For I = 1 To UBound(fileList)
        Me.ListBox1.AddItem fileList(I)
    Next
End Sub

Open in new window

0
 
MutsopAuthor Commented:
This doesn't make much sence...
The CommandButton3 populates the listbox.

As of CommandButton4 should print the selected items.
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

 
krishnakrkcCommented:
Hi,

Try

Kris
Private Sub CommandButton3_Click()
Dim FileList() As String
Dim fName As String
Dim fPath As String
Dim i As Integer
Me.ListBox1.Clear
 'define the directory to be searched for files
fPath = "Z:\Templates\fr-fr\Offres + transport\"
'build a list of the files
fName = Dir(fPath & "*.doc")
While fName <> ""
     'add fName to the list
    i = i + 1
    ReDim Preserve FileList(1 To i)
    FileList(i) = fName
     'get next filename
    fName = Dir()
Wend
 'see if any files were found
If i = 0 Then
     MsgBox "No files found"
    Exit Sub
ElseIf i = 1 Then
    Me.ListBox1.AddItem FileList(i)
Else
    Me.ListBox1.List = Application.Transpose(FileList)
End If
End Sub
Private Sub CommandButton4_Click()
Dim i As Long, sFiles(), n As Long
Dim sDocFile As String
Dim sPDFFile As String

'Change the path to whatever you want it to be.
sDocFile = "Z:\Templates\be-nl\Offerte Cimtech Filter.doc"

With Me.ListBox1
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            n = n + 1
            ReDim Preserve sFiles(1 To n)
            sFiles(n) = .List(i, 0)
        End If
    Next
End With
If n > 0 Then
    For i = 1 To n
        Call DOC2PDF(sFiles(i), sPDFFile) 'Note: sPDFFile is optional
    Next
End If
End Sub

Open in new window

0
 
MutsopAuthor Commented:
Thanks,

Have one last problem though.
I included the print function below which I found somewhere on the web.

Now I understand most part of the script.

Now when I try to test out with a selected document it gives me the error that the doc doesn't exist.
After some research I checked the local variables and found out that the 'path' isn't pointing to the place where the word documents are.

Instead of pointing to for example "Z:\Templates\Formulier\" it points to the documents folder.

First of I thought that it was cause my xls file was saved there. So I moved it to the same folder as the .docs..... Not working. Although in the script it states

  sDocFile = fso.GetAbsolutePathname(sDocFile)
 
  sFolder = fso.GetParentFolderName(sDocFile)


Any ideas?

Regards





Function DOC2PDF(sDocFile, sPDFFile)
  Dim fso ' As FileSystemObject
  Dim wdo ' As Word.Application
  Dim wdoc ' As Word.Document
  Dim wdocs ' As Word.Documents
  Dim sPrevPrinter ' As String
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set wdo = CreateObject("Word.Application")
  wdo.Visible = True
  
  
  Set wdocs = wdo.Documents
 
  sTempFile = fso.GetSpecialFolder(TemporaryFolder) + "\" + fso.GetTempName()
 
  sDocFile = fso.GetAbsolutePathname(sDocFile)
 
  sFolder = fso.GetParentFolderName(sDocFile)
 
  If Len(sPDFFile) = 0 Then
    sPDFFile = fso.GetBaseName(sDocFile) + ".pdf"
  End If
 
  If Len(fso.GetParentFolderName(sPDFFile)) = 0 Then
    sPDFFile = sFolder + "\" + sPDFFile
  End If
 
  ' Remember current active printer
  sPrevPrinter = wdo.ActivePrinter
 
  wdo.ActivePrinter = "PDFcreator"
 
  ' Open the Word document
  Set wdoc = wdocs.Open(sDocFile)
  ' Print the Word document to the Acrobat Distiller -
  ' will generate a postscript (.ps) (temporary) file
  wdo.ActiveDocument.PrintOut False, , , sTempFile
 
  ' This outcommented part was used while trying to use "Acrobat PDFWriter"
  'Do While wdo.BackgroundPrintingStatus > 0
  ' 'Do nothing - just wait for printing to finish before closing Word
  'Loop
 
  wdoc.Close WdDoNotSaveChanges
  wdo.ActivePrinter = sPrevPrinter
  wdo.Quit WdDoNotSaveChanges
  Set wdo = Nothing
 
  ' Debug output...
  'If bShowDebug Then
  'WScript.Echo " Distilling to '" + sPDFFile + "'"
  'End If
 
End Function

Open in new window

0
 
CSecurityCommented:
This path:
Z:\Templates\Formulier\

Is in the code, maybe you need to change that
0
 
MutsopAuthor Commented:
Well Instead of

  sDocFile = fso.GetAbsolutePathname(sDocFile)
  sFolder = fso.GetParentFolderName(sDocFile)

I used this then:

  sDocFile = "Z:\Templates\Formulier\" & sDocFile
  sFolder = "Z:\Templates\Formulier\"

But it's just that I don't get why the GetAbsolutePathname isn't working...
If someone does know the answer why... Let me know.

Thanks though :)
0
 
MutsopAuthor Commented:
Thanks again for your help :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.