retrieve object from multiple closed workbook and paste into open workbook.

niailmar

New member
Joined
Apr 4, 2012
Messages
30
Reaction score
0
Points
0
Very good day to all.

In my situation, I have multiple workbook that located in C directory.
Each these workbook have 1 form that stored a various employee data. It is means, 1 form for 1 employee.


I also have another workbook that called REPORT (my system database) which is stored all employee data inside here. When I open the report, it will auto saved data into this database. All the required data need to be saved by automatically.


My problem here is, inside all these form from multiple closed workbook have the object in various format (JPEG, WORD,TXT, PDF). I need to retrieve all the object inside there and paste it into REPORT. Can anybody show me some guide how to solve this problem using vba code.

Thank and best regards,
-nia-
 
Hi nia,

Can you upload a sample of what the source and destination workbooks look like? Please strip out any confidential info, but this may help make it easier to diagnose.

Thanks,
 
The destination of PMCare_Report workbook will be located at C directory. For example: C:\PMCare\Report


Another folder will be created to store all the email attachments that contains all form received by email.


For example: C:\PMCare\PCForm\Personal Claim Form of LINDA TOM


From the 'Personal Claim Form of LINDA TOM' it have the object (in JPEG, PDF, or TXT format) that user attach the receipt. So I need the objects from many form to be paste into database. And from database, user can click the object to view the receipt.


Please refer the attachment for our sample workbook looks like. Thank you.


Best Regards,


-nia-
 

Attachments

  • report.zip
    850.7 KB · Views: 25
Hi Nia,

Just curious here... when you say Database, you mean the "C:\PMCare\Report.xlsm" Excel file, correct?

And what you're looking for is to insert the actual picture into the Excel workbook, wether it is PDF, JPG or TXT?

That's going to be a tough one. I wonder though... would it be okay to insert a hyperlink back to the original document? We could hook up a routine that the user could use to browse to the file and insert a hyperlink to the document. Would that work?
 
Absolutely yes!
The report.xlsm should be the database. Actually the object attached at the form is receipt. So, sometimes user scan the receipt and saved it in various format such as PDF or JPG.Is that possible to be done in multiple format or only can be set for one format?


Before this, I'm also search about how to do that. But what i found is only to have insert for the one picture. The problem is, how can I do to insert all images in database from retrieve all the object form in email attachments?


If it could be tough to solve, what about insert the hyperlink? Correct me if I mistaken. What i'm understand is, the hyperlink can be appear at the attachment column (in database: report.xlsm) and user can view the original document by clicking that link. So, if the user want to see the object, they need to click the object area at the form. Is that right?


much appreciated for your kindness help. Thank you!
-nia-
 
insert hyperlink to all closed workbook in folder

Hello Ken,

Continue my previous question.
Is that possible to insert hyperlink (database: report.xlsm) for each closed workbook in 1 same folder?
What I mean is, when I generate the report.xlsm, the database can show all the required data include hyperlink to link each closed workbook. My problem right now is only to catch up the link. The others data is already done.
From function in excel just only can be done in linking for the 1 data. Below is my code for read data from all closed workbook in folder.

Sub ReadDataFromAllWorkbooksInFolder1()Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, I As Integer
Dim a, b, c, d, e, F, g, h, j, k, l, m, n As String




FolderName = "C:\cube\GLForm"
' create list of workbooks in foldername
wbCount = 0
wbName = Dir(FolderName & "\" & "*.xls")
While wbName <> ""

wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
Wend
If wbCount = 0 Then Exit Sub
' get values from each workbook
r = 9

'perlu edit tuk letak template
'Workbooks.Add

Sheets("Guarantee Letter").Select


For I = 1 To wbCount
r = r + 1
cValue = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "F57")

'edit

a = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "F58")
b = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "F59")
c = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "F60")
d = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "F62")
e = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "F63")
F = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "F64")
g = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "F65")
h = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "F66")
j = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "B990")
k = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "B991")
l = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "C990")
m = GetInfoFromClosedFile(FolderName, wbList(I), "GLForm", "C991")


'Cells(r, 2).Formula = wbList(i)
Cells(r, 3).Formula = cValue

'edit
Cells(r, 4).Formula = a
Cells(r, 5).Formula = b
Cells(r, 6).Formula = c
Cells(r, 7).Formula = d
Cells(r, 8).Formula = e
Cells(r, 9).Formula = F
Cells(r, 10).Formula = g
Cells(r, 11).Formula = h
Cells(r, 12).Formula = j
Cells(r, 13).Formula = k
Cells(r, 14).Formula = l
Cells(r, 15).Formula = m



'Cells(i, "W").Value = cb15
'Cells(i, "X").Value = others
'Cells(i, "Y").Value = resit


Next I

End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & "\" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function

Really appreciate for any given solution. Thank You :)
 
The report.xlsm should be the database. Actually the object attached at the form is receipt. So, sometimes user scan the receipt and saved it in various format such as PDF or JPG.Is that possible to be done in multiple format or only can be set for one format?

The issues you'll run into here are:
1) Images, PDFs, etc.. take a lot of space. Your workbook will VERY quickly grow to be unmanageable and potentially even crash
2) Sizing and aligning the icons will be a pain as well

niailmar said:
If it could be tough to solve, what about insert the hyperlink? Correct me if I mistaken. What i'm understand is, the hyperlink can be appear at the attachment column (in database: report.xlsm) and user can view the original document by clicking that link. So, if the user want to see the object, they need to click the object area at the form. Is that right?

Correct. Try this code to see if it works for you:
Code:
Sub GetHyperLink()
    Dim sFilePath As String
    
    sFilePath = CStr(Application.GetOpenFilename)
    
    If sFilePath = "False" Then Exit Sub
    
    With ActiveCell
        .Hyperlinks.Add anchor:=ActiveCell, Address:=sFilePath, TextToDisplay:=sFilePath
    End With
End Sub

Click in column J, then run this. It will pop up a browser asking you to select the file, then will put in a hyperlink to that file.

We can also get all files linked from the directory as well, but let's verify that this will work for you first.
 
Hi Ken,
I already test that coding, and it showing the pop up browser. So, how can I get all file linked from the directory as well?


And I have another 1 question for you.
Before that, I already test the code with this one:


Code:
'Cells(r, 2).Formula = wbList(i)


And the result is it can appear the name of that workbook (form) at the the attachment column
(Report.xlsm). Is that possible can I insert hyperlink the workbook name direct to their location?


Can you give some solution for this problem.
Thanks :)
 
Hi niailmar,

If you're just trying to get all the existing files into a list for your history, you could run this in another worksheet:
Code:
Sub HyperlinkFileList()
    Dim fso As Object, _
    ShellApp As Object, _
    File As Object, _
    SubFolder As Object, _
    Directory As String, _
    Problem As Boolean
     
     'Turn off screen flashing
    Application.ScreenUpdating = False
     
     'Create objects to get a listing of all files in the directory
    Set fso = CreateObject("Scripting.FileSystemObject")
     
     'Prompt user to select a directory
    Do
        Problem = False
        Set ShellApp = CreateObject("Shell.Application"). _
        Browseforfolder(0, "Please choose a folder", 0, "c:\\")
         
        On Error Resume Next
         'Evaluate if directory is valid
        Directory = ShellApp.self.Path
        Set SubFolder = fso.GetFolder(Directory).Files
        If Err.Number <> 0 Then
            If MsgBox("You did not choose a valid directory!" & vbCrLf & _
            "Would you like to try again?", vbYesNoCancel, _
            "Directory Required") <> vbYes Then Exit Sub
            Problem = True
        End If
        On Error GoTo 0
    Loop Until Problem = False
     
     'Adds each file, details and hyperlinks to the list
    For Each File In SubFolder
        With ActiveSheet
             'Add hyperlink with full path displayed
            .Hyperlinks.Add _
                Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                Address:=File.Path, _
                TextToDisplay:=File.Name
        End With
    Next
     
End Sub

That will get you hyperlinks to all the files, so you could cut/paste those you need.

If you're trying to collect multiple files each time someone adds one file, then I think I'll need a little more explanation of what we're looking at. I.e. If the user chooses to add one file, should the application scan the directory the user chose and add all files?

Not sure I'm totally clear on this one right now.
 
Back
Top