Posts by arestyus

arestyus · Sep 24th 2020

Let's I have changed the way I have structured the e-mail content and before adding the snip I added some extra lines that insert a range from Activesheet.

Code

Range("J5:U9").Copy
contentR.Application.Selection.Start = Len(.Body)
contentR.Application.Selection.Paste

Problem is that for some e-mails I get error 1004 - Copy method of picture class failed highlighting the copy codeline and if I click debug and press F5 the macro resumes from where it broke - with job complete. For a few e-mails is ok to press debug and F5 but for more than 100 is not funny.

I have tried with an On error resume next but for the e-mails where the error would occur I get them incomplete (no range and no image inserted).

Any ideea on how to bypass it ?

arestyus · Sep 8th 2020

MODERATOR NOTICE: This topic has also been posted on other sites and may already have an answer elsewhere. Please take this into consideration when answering this question

mrexcel.com/board/threads/imag…n-e-mail-via-vba.1145132/

Hello everyone,

I have a macro-code that attaches a picture in the e-mail body from the excel Activesheet. My problems are:

Is there a possibility to place the image above "Thank you" line ?
If I want to insert a second picture how can I modify the code so that the Picture2 will be placed bellow Picture1 (currently it's placing in the right of Picture1)

Any ideas ?

Code

Sub create_email_2()
Dim oApp As Outlook.Application
Dim email As Outlook.MailItem
Dim inspect As Outlook.Inspector
Dim content As Object
Set oApp = New Outlook.Application
Set email = oApp.CreateItem(olMailItem)
With email
.To = "[email protected]"
.Subject = "E-mail2"
.htmbody = "Hello" & "</p>" _
& "Please see bellow current status" & "</p>" _
& "Thank you" & "</body></html>"
.Display
Set inspect = email.GetInspector
Set content = inspect.WordEditor
ActiveSheet.Pictures(1).Copy
content.Application.Selection.Start = Len(.Body)
content.Application.Selection.Paste
'ActiveSheet.Pictures(2).Copy
'content.Application.Selection.Start = Len(.Body)
'content.Application.Selection.Paste
.Save
'.Send
End With
End Sub

Display More

arestyus · May 17th 2020

Please find attached the zip archive.

arestyus · May 17th 2020

dangelor , tried but then it's erroring a lot (Rng, cell, chck etc.)

royUK , sorry with the format. Tried your code but still not working.

Technically that part refers to those folder paths inserted in the Range from Sheets "Library" and use them as variable.

arestyus · May 8th 2020

Quote from Fluff13

In that case, how about

Code

lkprez = Application.VLookup(.Cells(i, 4).Value, lkparr, 1, False)

Tried it again and it retrieves "#"

arestyus · May 8th 2020

Quote from Fluff13

How about

Code

Sub ana()

Dim lkupval As String

Dim lkparr As Range

Dim i As Long

Dim lkprez As Variant

Set lkparr = Sheets("Business").Range("D1:D" & Rows.Count).End(xlUp)

With Sheets("2nd sheet")

For i = 2 To .Range("D2").End(xlDown).Row

''/// searches in Sheets("Business")

lkprez = Application.VLookup(.Cells(i, 1).Value, lkparr, 1, False)

''/// puts result in 2nd sheet

If Not IsError(lkprez) Then

.Cells(i, 30) = lkprez

Else

.Cells(i, 30) = "#"

End If

Next i

End With

End Sub

Display More

It does work, however instead of counting 30 starting Col. D it counts starting col.A

arestyus · May 8th 2020

Correction: filenames start with "BRIDGE"

arestyus · May 8th 2020

Hello,

I have a macro that consolidates all filenames that start with "BDRIDGE" and have a "DATAx" sheet.name from all containing subfolders. The path of the subolders being added in the 1st sheet of the macro file.

My problem is that the macro does not retrieve anything as it only runs and creates a blank new sheet without data.

Any help please ? ( zip archive attached also)

Code

Sub CopWKBooksInFolder()
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
Str = Application.InputBox(prompt:="Search only sheet names containing this string:", Title:="Search worksheet whose name contain this string:", Type:=2)
On Error Resume Next
Set Rng = Application.InputBox(prompt:="Select a cell range containing paths to folders" _
, Title:="Select a cell range", Default:=ActiveCell.Address, Type:=8)
On Error GoTo 0
Set WS = Sheets.Add
For Each cell In Rng
If Dir(cell.Value, vbDirectory) <> "" Then
chk = 0
Value = Dir(cell.Value)
Do Until Value = ""
If Value = "." Or Value = ".." Then
Else
If Left(Value, 6) = "BRIDGE" Then
On Error Resume Next
Workbooks.Open Filename:=cell.Value & Value
If Err.Number > 0 Then
Else
On Error GoTo 0
For Each sht In ActiveWorkbook.Worksheets
If InStr(sht.Name, Str) <> 0 Then
If sht.Range("A1") <> "" Then
Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
If chk = 0 Then
sht.Range("A1").CurrentRegion.Copy Destination:=WS.Range("A" & Lrow)
chk = 1
Else
Set crng = sht.Range("A1").CurrentRegion
Set crng = crng.Offset(1, 0)
Set crng = crng.Resize(crng.Rows.Count - 1)
crng.Copy Destination:=WS.Range("A" & Lrow)
End If
End If
End If
Next sht
End If
Workbooks(Value).Close False
On Error GoTo 0
End If
End If
Value = Dir
Loop
End If
Next cell
Cells.EntireColumn.AutoFit
End Sub

Display More

Testing.zip Testing.zip

arestyus · May 8th 2020

Hi,

Still getting "Unable to get the vlookup property of the Worksheetfunction class" 1004 error highlighting

lkprez = Application.WorksheetFunction.VLookup(.Cells(i, 1).Value, lkparr, 1, False)

arestyus · May 8th 2020

Thats because I want to adapt it to vlookup +iferror from book 1 to book2 and neither of this workbooks will have static name

arestyus · May 8th 2020

Hello,

I created vlookup + iferror code but I am getting the error 1004 and I am stuck.

The principle is to do a vlookup in sheet("ana").Range("AG2:AG) (being Cells(i,30)) from other sheet Range(D:D )

Can you please help ?

Code

Sub ana()
Dim lkupval As String
Dim lkparr As Range
Dim i As Long
Dim lkprez As Long
Set lkparr = Sheets("Business").Range("D1:D500000")
Sheets("2nd sheet").Activate
For i = 2 To Range("D2").End(xlDown).Row
Set lkpval = Cells(i, 1)
lkprez = Application.VLookup(lkpval, lkparr, 1, False)
If Not IsError(lkprez) Then
Cells(i, 30) = lkprez
Else
Cells(i, 30) = "#"
End If
Next i
End Sub

Display More

Posts by arestyus

Image placement in an e-mail via VBA

Image placement in an e-mail via VBA

Vlookup with iferorr not working

Macro merger of filenames that start with a specific name

Vlookup with iferorr not working

Vlookup with iferorr not working

Macro merger of filenames that start with a specific name

Macro merger of filenames that start with a specific name

Vlookup with iferorr not working

Vlookup with iferorr not working

Vlookup with iferorr not working