VBA code works in office 2007 not in office 2010(embeds an attachment in excel)

[amnandu]

I have a code which works fine in office 2007 but when i move to another machine which has 2010 it doesnt work( actually it dosent show up the image and the label name)
Below is the code working for 2007

Sub Attachment()
Dim filters As String
Dim filename1 As Variant


  Sheets.Add.Name = "Attachments"
  Sheets("SCR Form").Move Before:=Sheets("Attachments")


    ' Get the file name.
     filename1 = Application.GetOpenFilename(FileFilter:="Select Files(*.xls;*.xlsx;*.pdf;*.doc;*.docx;*.ppt),*.xls;*.xlsx;*.pdf;*.doc;*.docx;*.ppt", Title:="Select a file")
    If filename1 = False Then Exit Sub


    ' Insert the file.
    InsertPicture CStr(filename1), Application.Selection
  End Sub


' Insert a picture into a cell.


Sub InsertPicture(filename1 As String, location As Range)
Dim objI As Object
Dim rngI As Range




'For Each rngI In Range("H3:H4")
Sheets("Attachments").Range("A2") = "Attachments Below"
    Set myDocument = Sheets("Attachments")
   Set objI = Sheets("Attachments").OLEObjects.Add(Filename:=filename1, Link:=False, DisplayAsIcon:=True, IconFileName:=filename1, IconLabel:=filename1) ', Width:=40, Height:=40)


   objI.Top = 30
    objI.Left = 5 


End Sub

Please suggest what i need to look up for when moving to 2010.
Also i want an option of adding multiple files in my excel.. any suggestions or solution for it??
Thanks in Advance
Kumar

[Bob Phillips]

Works for me in 2010. Creates an embedded file with an Excel image in the Attachments sheet.

[amnandu]

Thanks for the reply xld.

For some reason at my end i cannot see the image and image label in my PC. also tried in another PC which dosent work either. Could this be something to do with add-in?? or you suspect anything other than this??

Also can you help me in attaching multiple files in the attachments sheet please ??

Thanks
Kumar

[Aflatoon]

If you check File-Options-Advanced, and scroll halfway down to the 'Display options for this workbook' section, what do you have selected for the 'For objects show:' option? 'All' or 'Nothing'?

[amnandu]

Thanks for reply Aflatoon.

I have "All" selected ...

[amnandu]

Hey All,


Please some one help me in fixing my issue?? Also about adding multiple files in the excel sheet...


Thanks
Kumar

[westconn1]

would we assume that the machine with later office also has later operating system?

Also about adding multiple files in the excel sheet...

change the getopenfilename call to multiselect, last parameter to true

     ' Insert the files.
for each f in filename1
    InsertPicture CStr(f), Application.Selection  'if you use like this each file will be inserted at the same location, change to a dynamic range
next

change he location to different place for each file, then use that location in the insert picture procedure, as it is already passed as a parameter

[amnandu]

In both the machines os is windows xp sp 3. Am really unsure why this is not working..

By using below code i get error "onject dosent support this property or method "

filename1 = Application.MultiSelect(FileFilter:="Select Files(*.xls;*.xlsx;*.doc;*.docx;*.ppt),*.xls;*.xlsx;*.doc;*.docx;*.ppt", Title:="Select a file")

By using the below code i get error "Type Mismatch"

' Insert the files.
For Each f In filename1 
    InsertPicture CStr(f), Application.Selection 'if you use like this each file will be inserted at the same location, change to a dynamic range
Next

Please suggest how to proceed further...

Thanks
Kumar

[westconn1]

By using below code i get error "onject dosent support this property or method "

you still have to call getopenfilename same as before, just change the parameter for multiselect to true
pres F1 for help

you need to change application.selection to a valid range, different for each file, i do not know from your example which part is giving type mismatch error
you can not use font and color tags within code tags

while you do not have getopenfilename correct the other is likely to throw an error, as filename1 is not an array until multiselect is used

[Bob Phillips]

I would suggest you post the full workbook and let us play with it, see if we can reproduce the problem.

[jack nt]

try this:
options/trust center, click "trust center settings..." and check "enable trust center setting" (at bottom)
with some codes, 2007 not asks but 2010. i met it when change codes when runing.

[amnandu]

As per your comment in the forum am sending you the attachment.


Please follow the steps to access the excel sheet


1. When you open the excel "SCR_Liggare.xslm", click NO.
2. Click on the New SCR tab, this would create a new xls sheet
3. In the new xls sheet created, Click to Add Attachments button is available. I want to add multiple files in another tab called "Attachments" if any.


The above shows an icon and icon label in Office 2007 personal PC when i work on Office 2010 PC it isnt shown.


Please help me in fixing this...


Thanks
Kumar

[Bob Phillips]

I had to change the code because it was failing on checking whether any attachments have been selected. I also added a bit of code to stop the attachments overlaying when more than one is selected. That aside, it seems to work

Sub Attachment()
Dim filters As String
Dim filename1 As Variant
Dim f As Variant
Dim idx As Long

  Sheets.Add.Name = "Attachments"
  Sheets("SCR Form").Move Before:=Sheets("Attachments")

    ' Get the file name.
  
        'filename1 = Application.GetOpenFilename(FileFilter:="Select Files(*.xls;*.xlsx;*.doc;*.docx;*.ppt),*.xls;*.xlsx;*.doc;*.docx;*.ppt", Title:="Select a file")
        filename1 = Application.GetOpenFilename(FileFilter:="Select Files(*.xls;*.xlsx;*.doc;*.docx;*.ppt),*.xls;*.xlsx;*.doc;*.docx;*.ppt", Title:="Select a file", MultiSelect:=True)
      
    If Not IsArray(filename1) Then
    
        If filename1 = False Then
        
            Application.DisplayAlerts = False
                Worksheets("Attachments").Delete
            Application.DisplayAlerts = True
            Exit Sub
        End If
    Else

        ' Insert the file.
        For Each f In filename1
        
            idx = idx + 1
            InsertPicture CStr(f), idx, Application.Selection
        Next
    End If
End Sub

Sub InsertPicture( _
    ByVal filename1 As String, _
    ByVal idx As Long, _
    ByRef location As Range)
Dim objI As Object
Dim rngI As Range

    Sheets("Attachments").Range("A2") = "Attachments Below"
    Set myDocument = Sheets("Attachments")

    Set objI = Sheets("Attachments").OLEObjects.Add(Filename:=filename1, Link:=False, DisplayAsIcon:=True, IconFileName:=filename1, IconLabel:=filename1) ', Width:=40, Height:=40)
    
    objI.Top = idx * 30
    objI.Left = 5
End Sub

Just tried closing the workbook, and it failed. Not sure what was going on, but it failed on a Left statement as it was using Instr and subtracting one, failed if not found. I also ran out of memory and had to abort excel.

[westconn1]

I also ran out of memory and had to abort excel.

don't you hate that?
seems strange as the op tells us it is working 2007
i figured whoever wrote the original code intended that location, passed as a range (currently unused) would position each icon in a cell area
also not sure why positioning is not done within the add method

[amnandu]

xld,

Thanks for the reply. But the code still behaves the same in my PC. i can only attach a single attachment ( but with missing icon and icon label). When i try to attach another files it throws an error 400 and creates antoher tab sheet4.

I was trying to create an attachment tab which holds multiple attachments.

Please suggest what could be done..

Thanks
Nanda

[amnandu]

westconn1,

the code i mentioned above is not working fine in 2010. In 2007 i can see the image and icon lable which i cant see in 2010 but attaches only single file.
Also tried embedding multiple files but am stuck...

Nanda

[Bob Phillips]

That is because you automatically try to add a sheet called Attachments. You should check if it already exists before adding it.

I find it difficult to understand how this code worked it 2007, there are logic and coding errors in it which are not just 2010 problems.

[Bob Phillips]

This should work better for you

Sub Attachment()
Const SHEET_NAME_ATTACHMENTS As String = "Attachments"
Dim ws As Worksheet
    Dim filters As String
    Dim filename1 As Variant
    Dim f As Variant
    Dim idx As Long
     
    filename1 = Application.GetOpenFilename(FileFilter:="Select Files(*.xls;*.xlsx;*.doc;*.docx;*.ppt),*.xls;*.xlsx;*.doc;*.docx;*.ppt", Title:="Select a file", MultiSelect:=True)
     
    If Not IsArray(filename1) Then
         
        If filename1 = False Then
            Exit Sub
        End If
    Else
     
        On Error Resume Next
        Set ws = Worksheets(SHEET_NAME_ATTACHMENTS)
        On Error GoTo 0
        If ws Is Nothing Then
        
            Set ws = Worksheets.Add(After:=Worksheets("SCR Form"))
            ws.Name = SHEET_NAME_ATTACHMENTS
        End If
         
        For Each f In filename1
             
            idx = idx + 1
            InsertPicture CStr(f), ws, idx, Application.Selection
        Next
    End If
End Sub
 
Sub InsertPicture( _
    ByVal filename1 As String, _
    ByRef sh As Worksheet, _
    ByVal idx As Long, _
    ByRef location As Range)
    Dim objI As Object
    Dim rngI As Range
     
    sh.Range("A2") = "Attachments Below"
     
    Set objI = sh.OLEObjects.Add(Filename:=filename1, Link:=False, DisplayAsIcon:=True, IconFileName:=filename1, IconLabel:=filename1) ', Width:=40, Height:=40)
     
    objI.Top = idx * 30
    objI.Left = 5
End Sub

[amnandu]

xld,


This works fine and can take multiple files but are storing at a single location when ever i select multiple files.

I tried this code in 2007 and works perfect but with over lap of the attachments.

I think for some reason the idx is not incrementing its location... any suggestions??

Nanda

[Bob Phillips]

It does increment, you can see it where it says idx = idx + 1

It will overlap on a subsequent run, as it doesn't check if any are already there.

You might want to increase the 30 in the line objI.Top = idx * 30 to create a gap between them.