Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Whatsapp automation with VFP 3

Status
Not open for further replies.
TariqMehmod

TariqMehmod

Programmer
Mar 4, 2004
100
PK
Dear All,

Here is an attempt to send text messages,images,contents to whatsapp.
No need of any third party dll etc.

I have tested all method before uploading.
All methods work fine.

Before testing any method, you must have Whatsapp installed on your system

Link

Please enter whatsapp number on International format like 923000000000
Do not include +, 00 or dashes.

*--------------------------------------------------
Method:1- How to send simple message
*--------------------------------------------------
Code: 
 Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923000000000]
ccMessage=[How are you sir?]
cmd='whatsapp://send?phone=&cPhone&text='+ccMessage
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.sendKeys ( '{ENTER}' )
Else
	Messagebox ( "Whatsapp is not activated!" )
Endif

*--------------------------------------------------
Method:2- How to send an image file
*--------------------------------------------------
Code: 
 Do image_to_clip
** Declare Sleep
Declare Sleep In kernel32 Integer

Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.sendKeys ("^{v}")
sleep(2000)
	ox.sendKeys ( '{ENTER}' )

Else
	Messagebox ("Whatsapp is not activated!" )
Endif

Procedure image_to_clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long    GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long

#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001

Local xpict
m.xpict=Getpict()
If !Empty(m.xpict)
	m.ext=Proper(Justext(m.xpict))
	If !Inlist(m.ext,"Png","Jpg","Bmp","Gif","Tif")
		Messagebox('Please select only images',0+16,'Whatsapp',3000)
		Return
	Endif
Else
	Messagebox('Image not selected',0+64,'Whatsapp',3000)
	Return
Endif

Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height

nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
	EmptyClipboard()
	SetClipboardData(CF_BITMAP, lhBmp)
	CloseClipboard()
Endif
Endproc

*--------------------------------------------------
Method:3- How to send Excel file as image
*--------------------------------------------------
Suppose I have this Excel File
C:\XLS\daily.xlsx

[URL unfurl="true"]https://res.cloudinary.com/engineering-com/raw/upload/v1606821683/tips/daily_wihilk.xlsx[/url]

I shall convert this file into image without loosing format first then later send to whatsapp
You must have following 3 file in same folder
gpimage.FXP,gpimage.h,gpimage.prg
Download attachment that have all those 3 files

The following codes will generate a bmp file like this

[URL unfurl="true"]https://res.cloudinary.com/engineering-com/image/upload/v1606821894/tips/9e97ccb8-f290-4ad1-9383-76281d5548ce_dx4qyv.bmp[/url]

Code: 
 Do excel2image

Function excel2image
xflname="" && Get image file name
ahour=Padl(Alltrim(Str(Hour(Datetime()))),2,'0')
amin=Padl(Alltrim(Str(Minute(Datetime()))),2,'0')
xflname=Alltrim("Tailor_")+Alltrim(Dtos(Date()))+"_"+ahour+amin

lcXLS =[C:\xls\daily.xlsx]
If Empty(lcXLS)
	Messagebox('Excel file not found',0+16,'System')
	Return
Endif

Local oForm
oForm = Createobject("Form")

With oForm
	.Height = 550
	.Width = 360
	.AutoCenter=.T.
	.Caption=m.xflname
	.MinButton=.F.
	.MaxButton=.F.
	.AlwaysOnTop=.T.
	.Newobject("ExcelObject","oleExcelObject")
	With .ExcelObject
		.Left = 0
		.Top = 0
		.Width = .Parent.Width - 10
		.Height = .Parent.Height - 10
		.Visible = .T.
	Endwith
	.Newobject("Timer1","oTimer")
Endwith

oForm.Show(1)
Define Class oleExcelObject As OleControl
	OleClass ="Excel.Sheet"  && Server name
	OLETypeAllowed = 0      && Linked
	DocumentFile = lcXLS && This file should exist
Enddefine

Define Class oTimer As Timer
	Interval=8000
	Procedure Timer
	This.Enabled = .F.
	Do ScreenShot With This.Parent
	This.Enabled = .T.
Enddefine

Procedure ScreenShot
Lparameters oForm

#INCLUDE gpImage.h

If Not "gpImage" $ Set("Procedure")
	Set Procedure To gpImage Additive
Endif

GDIP = Createobject("gpInit")
img = Createobject("gpImage")
img.Capture(oForm.HWnd)
Local lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = Sysmetric(9)
lnLeftBorder = Sysmetric(3)
lnTopBorder = Sysmetric(4)
img.Crop(lnLeftBorder, lnTitleHeight + lnTopBorder, ;
	img.ImageWidth - (lnLeftBorder * 2), ;
	img.ImageHeight - (lnTitleHeight + (lnTopBorder * 2)))
img.SaveasBMP('C:\Xls'+'\'+m.xflname)
img = Null
oForm.Release

Do image2Clip
Do send2whatsapp

Endfunc

Function image2Clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long  GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long

#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image. if used
Local m.xpict

m.xpict='C:\XLS'+'\'+m.xflname+'.bmp'
Messagebox(m.xpict)

If !Empty(m.xpict)
	m.ext=Proper(Justext(m.xpict))
	If !Inlist(m.ext,"Png","Jpg","Bmp","Gif","Tif")
		Messagebox('Please select only images')
		Return
	Endif
Else
	Messagebox('Image not selected')
	Return
Endif

Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height

*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
	EmptyClipboard()
	SetClipboardData(CF_BITMAP, lhBmp)
	CloseClipboard()
Endif
Endfunc

Function send2whatsapp
* Finally send this newly created image to whatsapp
Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.SendKeys ("^{v}")
Sleep(2000)
	ox.SendKeys ( '{ENTER}' )
Else
	Messagebox ( "Whatsapp is not activated!" )
Endif
Endfunc

*--------------------------------------------------
Method:4- How to send Bulk messages
*--------------------------------------------------
We shall create some data first

Code: 
 Create Cursor clients(mobile c(12))
Insert Into clients Values('923000000000')
Insert Into clients Values('923000000000')
Insert Into clients Values('923000000000')
Go Top
Scan
	Scatter Memv
	cPhone=ALLTRIM(m.mobile)
	cMessage=Alltrim('This is sales promotion message')

	Declare  Integer FindWindow In WIN32API String , String
	Declare  Integer SetForegroundWindow In WIN32API Integer
	Declare  Integer  ShowWindow  In WIN32API Integer , Integer
	Declare Integer ShellExecute In shell32.Dll ;
		INTEGER hndWin, ;
		STRING cAction, ;
		STRING cFileName, ;
		STRING cParams, ;
		STRING cDir, ;
		INTEGER nShowWin
	Local lt, lhwnd
	cmd='whatsapp://send?phone=&cPhone&text=' + cMessage
	=ShellExecute(0, 'open', cmd,'', '', 1)
	Wait "" Timeout 8 && 8 seconds internal in every message
	lt = "Whatsapp"
	lhwnd = FindWindow (0, lt)
	If lhwnd!= 0
		SetForegroundWindow (lhwnd)
		ShowWindow (lhwnd, 1)
		ox = Createobject ( "Wscript.Shell" )
		ox.sendKeys ( '{ENTER}' )
	Else
		Messagebox ( "Whatsapp is not activated!" )
	Endif
Endscan

*--------------------------------------------------
Method:5- How to send contents of text file
*--------------------------------------------------

Code: 
 cFile=Getfile('txt')
_Cliptext=Filetostr(cFile)

Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.sendKeys ("^{v}")
Sleep(2000)
	ox.sendKeys ( '{ENTER}' )
Else
	Messagebox ( "Whatsapp is not activated!" )
Endif

*--------------------------------------------------
Method:6- How to send Result Cards
*--------------------------------------------------
Suppose you are a principal of a school and want to send customized result card to parents.

Code: 
 Create Cursor result(rollno N(3),student c(15),Chem N(3),phy N(3),bio N(3),;
	eng N(3),math N(3),t_marks N(3),o_marks N(3),rem c(10),mobile c(13))
Insert Into result Values(1,'Ahmad Ali',78,25,33,85,50,500,271,'Pass','923000000000')
Insert Into result Values(1,'Zahid Mahmood',36,74,66,55,80,500,311,'Pass','92345000000')


Go Top
Scan
	Scatter Memv
	cPhone=Alltrim(m.mobile)

	cMessage='*Result Card*';
		+ '%0A'+'%0A';
		+ m.student;
		+ '%0A'+'%0A'+'Chem='+transform(m.Chem);
		+ '%0A'+'Bio='+transform(m.bio);
		+ '%0A'+'Phy='+transform(m.phy);
		+ '%0A'+'Eng='+transform(m.eng);
		+ '%0A'+'Math='+transform(m.math);
		+ '%0A'+'%0A'+'Total='+transform(m.t_marks);
		+ '%0A'+'Obtained='+Alltrim(Str(m.o_marks));
		+  '%0A' +'%0A'+'Remarks='+'*'+Alltrim(m.rem)+'*';
		+ '%0A' ;
		+ Replicate('-',20);
		+ '%0A'+'Principal:';
		+ '%0A'+'Allied Public School'

	Declare Sleep In kernel32 Integer
	Declare  Integer FindWindow In WIN32API String , String
	Declare  Integer SetForegroundWindow In WIN32API Integer
	Declare  Integer  ShowWindow  In WIN32API Integer , Integer
	Declare Integer ShellExecute In shell32.Dll ;
		INTEGER hndWin, ;
		STRING cAction, ;
		STRING cFileName, ;
		STRING cParams, ;
		STRING cDir, ;
		INTEGER nShowWin
	Local lt, lhwnd
	cmd='whatsapp://send?phone=&cPhone&text=' + cMessage
	=ShellExecute(0, 'open', cmd,'', '', 1)
	Sleep(2000)
	lt = "Whatsapp"
	lhwnd = FindWindow (0, lt)
	If lhwnd!= 0
		SetForegroundWindow (lhwnd)
		ShowWindow (lhwnd, 1)
		ox = Createobject ( "Wscript.Shell" )
		ox.sendKeys ( '{ENTER}' )
	Else
		Messagebox ("Whatsapp is not activated!" )
	Endif
Endscan

Parents will receive this message on their whatsapp.

1b167063-4df9-4775-be81-b6bf3f251f4a_nbhyam.png


Same like this, while using an accounting system you can send Ledger to your customers also.

If you want to be more intelligent, don't want to use columns name and values in message then play like this

Code: 
 FOR lnCnt = 1 TO FCOUNT()
  *** Get the Field Name
  lcField = FIELD( lnCnt )
  *** Get the field Value
  luFVal = &lcField
 
  *** Now do whatever you want with it
  ? lcField, luFVal
NEXT

see result

62dd418d-2d53-4643-a8da-a3ba450c1541_p5ptxm.png


*---------------------------------------------------
* Method:7- How to send unicode message from text file
*--------------------------------------------------

Some users asked me they want to send unicode message to whatsapp.
They have text file that contains data in their local language.

Suppose I have text file written our national lanugage URDU.
If I copy data from this file to VFP then data will be appear like this
?? ???? ??? ????? ???? ???? ??? ?? ???? ?????. ?? ?? ???? ????? ??

In this case I could not send this data to whats app with VFP codes

To make this data readable, I used my codes with this link


Here is complete routine

Code: 
 aa=Fullpath(Getfile('txt'))
tcUnicodeText=Strconv(Filetostr(aa), 5, 1256, 1)
*-------------------------------------------------
Do CopyUnicodeText2Clipboard With tcUnicodeText

Declare Sleep In kernel32 Integer

Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[923226857062]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.sendKeys ("^{v}")
	sleep(2000)
	ox.sendKeys ( '{ENTER}' )
Else
	Messagebox ("Whatsapp is not activated!" )
Endif


&& Copy Unicode text into Clipboard
Function CopyUnicodeText2Clipboard(tcUnicodeText)
Local lnDataLen, lcDropFiles, llOk, i, lhMem, lnPtr, lcUnicodeText

#Define CF_UNICODETEXT      13
&&  Global Memory Variables with Compile Time Constants
#Define GMEM_MOVABLE 	0x0002
#Define GMEM_ZEROINIT	0x0040
#Define GMEM_SHARE		0x2000

&& Load required Windows API functions
=LoadApiDlls()

llOk = .T.
lcUnicodeText = tcUnicodeText + Chr(0)+Chr(0)
lnDataLen = Len(lcUnicodeText)
&& Copy Unicode text into the allocated memory
lhMem = GlobalAlloc(GMEM_MOVABLE+GMEM_ZEROINIT+GMEM_SHARE, lnDataLen)
lnPtr = GlobalLock(lhMem)
=CopyFromStr(lnPtr, @lcUnicodeText, lnDataLen)
=GlobalUnlock(lhMem)
&& Open clipboard and store Unicode text into it
llOk = (OpenClipboard(0) <> 0)
If llOk
	=EmptyClipboard()
	llOk = (SetClipboardData(CF_UNICODETEXT, lhMem) <> 0)
&& If call to SetClipboardData() is successful, the system will take ownership of the memory
&&   otherwise we have to free it
	If Not llOk
		=GlobalFree(lhMem)
	Endif
&& Close clipboard
	=CloseClipboard()
Endif
Return llOk

Function LoadApiDlls
&&  Clipboard Functions
Declare Long OpenClipboard In WIN32API Long HWnd
Declare Long CloseClipboard In WIN32API
Declare Long EmptyClipboard In WIN32API
Declare Long SetClipboardData In WIN32API Long uFormat, Long Hmem
&&  Memory Management Functions
Declare Long GlobalAlloc In WIN32API Long wFlags, Long dwBytes
Declare Long GlobalFree In WIN32API Long Hmem
Declare Long GlobalLock In WIN32API Long Hmem
Declare Long GlobalUnlock In WIN32API Long Hmem
Declare Long RtlMoveMemory In WIN32API As CopyFromStr Long lpDest, String @lpSrc, Long iLen
RETURN

The result of above codes on whatsapp is as follows

27fc7e46-4243-4560-8d57-c798d45c42b5_unrzoy.png


You can read more about Unicode and Locale


*---------------------------------------------------
Method:8- How to send POS Invoice
*--------------------------------------------------
Today a user asked how to send POS Invoice/bill to customer on the spot.
It was good idea to get customers focus.
There are many issues to use custom page in VFP reports.
So there was need to send report on whatsapp with a small size to fit on Mobile Screen.

You must have following files in same folder before executing codes
(Files are in second attachment)

Suppose I want to send this invoice to customer.
a2e6a2c7-2089-46c1-9dde-f6c369c6167c_ngi84t.png


To achieve this goal please give a try to following codes:
Code: 
 Create Cursor pos(items c(25),qty N(3),price N(3),Total N(4))

Insert Into pos Values('KAJU SADA 50G',1,150,150)
Insert Into pos Values('Kaju Roasted 50G',1,170,170)
Insert Into pos Values('AKHROT MAGAZ 50G',2,90,180)
Insert Into pos Values('Pista Namkeen 100G',1,250,250)
Insert Into pos Values('SANGARI NISRI 100G',1,30,30)
Insert Into pos Values('GANDAM DALYA 500G',1,50,50)
Insert Into pos Values('PODINA TIKI 50G',1,25,25)
Insert Into pos Values('CHAR MAGAZ 100G',1,65,65)
Insert Into pos Values('HARMONY LEMON 150G',1,65,65)
Insert Into pos Values('L C KA BEEG 100G',1,40,	40)
Insert Into pos Values('SERVING CUP BACHA',1,150,150)

#include excel.h
#Define xlA1 1
#Define xlR1C1 -4150
#Define xlLastCell 11

bError = .F.
On Error bError = .T.
loExcel = Createobj("excel.application")
If bError
	Messagebox("Error")
	Return
Endif
*MessageBox("Version: " + loExcel.Version) && version number
On Error

xflname="" && Get Excel file name
ahour=Padl(Alltrim(Str(Hour(Datetime()))),2,'0')
amin=Padl(Alltrim(Str(Minute(Datetime()))),2,'0')
xflname=Alltrim("Tailor_")+Alltrim(Dtos(Date()))+"_"+ahour+amin
xflname=Alltrim("Tailor_")+Alltrim(Dtos(Date()))+"_"+ahour+amin


Select pos
Copy To 'C:\Xls\'+Alltrim(xflname)+Alltrim('.xls') Type Xl5
rec1=Reccount()
rec2=Reccount()+6

loExcel = Createobject("Excel.Application")
loworkbook = loExcel.workbooks.Open('C:\Xls\'+Alltrim(xflname))
losheet = loworkbook.sheets(1)

* insert 4 empty rows before data
With loExcel.activeworkbook.activesheet
	.usedrange.RowHeight = 15
	.Rows("1:4").Insert()
Endwith

&& First Line
losheet.Range("A1").Value=[Ehsas Mart]
With loExcel.Range("A1:D1")
	.horizontalalignment = xlcenter
	.verticalalignment = xlcenter
	.wraptext = false
	.Orientation = 0
	.shrinktofit = false
	.mergecells = true

	.Font.Color = Rgb(128,64,64)
	.Font.Name = 'Verdana'
	.Font.bold = .T.
	.Font.Size = 16
	.RowHeight=22
Endwith

&& Second Line
losheet.Range("A2").Value=[Opp. Government Printing Press]
With loExcel.Range("A2:D2")
	.horizontalalignment = xlcenter
	.verticalalignment = xlcenter
	.wraptext = false
	.Orientation = 0
	.shrinktofit = false
	.mergecells = true

	.Font.Color = Rgb(0,0,0)
	.Font.Name = 'Verdana'
*  .FONT.Bold = .T.
	.Font.Size = 10
	.RowHeight=15
Endwith

&& Third line
losheet.Range("A3").Value=[Bahawalpur, Ph.062-2504438]
With loExcel.Range("A3:D3")
	.horizontalalignment = xlcenter
	.verticalalignment = xlcenter
	.wraptext = false
	.Orientation = 0
	.shrinktofit = false
	.mergecells = true

	.Font.Color = Rgb(0,0,0)
	.Font.Name = 'Verdana'
*	.Font.bold = .T.
	.Font.Size = 10
	.RowHeight=15
Endwith

&& Fourth line
losheet.Range("A4").Value=[21-Nov-2020 5:33pm        Invoice No. 166]
With loExcel.Range("A4:D4")
	.horizontalalignment = xlleft
	.verticalalignment = xlcenter
	.wraptext = false
	.Orientation = 0
	.shrinktofit = false
	.mergecells = true

	.Font.Color = Rgb(50,50,150)
	.Font.Name = 'Verdana'
	.Font.Size = 8
	.Font.bold = .T.
	.Font.Italic = 1
	.RowHeight=15

Endwith

* Body Font name
rec5=5
With losheet.Range("A"+Alltrim(Str(rec5))+":"+"D"+Alltrim(Str(rec2)))
	.Font.Name="Verdana"
Endwith

&& Foramt
rec4=4
losheet.Range("D"+Alltrim(Str(rec4))+":"+"D"+Alltrim(Str(rec2))).numberformat = "#[=0];###,###"

&& Headings
losheet.Range("A5").Value = "Name"
losheet.Range("B5").Value = "Qty"
losheet.Range("C5").Value = "Price"
losheet.Range("D5").Value = "Total"
losheet.Columns(1).AutoFit()

* Border of heading row
With loExcel.sheets(1).Range("A5:D5")
	.BorderS(xlEdgeLeft).LineStyle = xlContinuous
	.BorderS(xlEdgeTop).LineStyle = xlContinuous
	.BorderS(xlEdgeBottom).LineStyle = xlContinuous
	.BorderS(xlEdgeRight).LineStyle = xlContinuous
Endwith

* Heading Row
With loExcel.sheets(1).Range("A5:D5")
	.Font.Name = 'Verdana'
	.Font.bold = .T.
	.RowHeight=20
	.Font.Color = Rgb(10,25,245)
*	.interior.Color = Rgb(10,235,245)
	.interior.Color = 0x00FFFF
	.horizontalalignment = -4108
	.verticalalignment = -4108
Endwith

&& Summary Row
With losheet.Range("A"+Alltrim(Str(rec2))+":"+"D"+Alltrim(Str(rec2)))
	.RowHeight = 20
	.Font.Color = Rgb(0,0,255)
	.interior.Color = Rgb(204,255,204)
	.Font.Name = 'Verdana'
	.Font.bold = .T.
	.horizontalalignment = -4108
	.verticalalignment = -4108
Endwith

rec3=rec2-1
&& Summary with Formula
losheet.Range("A"+Alltrim(Str(rec2))).Value = "TOTAL"
losheet.Range("b"+Alltrim(Str(rec2))).Formula = "=SUM(b2:b" + Alltrim(Str(rec3)) + ")"
losheet.Range("d"+Alltrim(Str(rec2))).Formula = "=SUM(d2:d" + Alltrim(Str(rec3)) + ")"

* column data autofit
For lni = 1 To Fcount("pos")
	lccolumn = Chr(lni+96)+":"+Chr(lni+96)
	loExcel.Columns(lccolumn).entirecolumn.AutoFit
Endfor

* Last Row/Column
lnLastRow = losheet.usedrange.Rows.Count
lnLastCol = losheet.usedrange.Columns.Count
thanks=lnLastRow+3
losheet.Range("A"+Alltrim(Str(thanks))).Value = "Thanks for visiting"

* Borders
loExcel.activewindow.displaygridlines = .F.

&& page margin
Local plportrait, pctitlerange, pllegal, pcprintarea, lnmargin
plportrait=.T.
pctitlerange="L"

With losheet.pagesetup
	If plportrait = .T.
		.Orientation = 1
	Else
		.Orientation = 2
	Endif

	If pllegal = .T.
		.Papersize = 5
	Else
		.Papersize = 1
	Endif
*	.PaperSize = 5 && 5 for legal 1 for landscap
*	.Orientation = 1  && 1 for portrati 2 for landscap
	.topmargin     = loExcel.inchestopoints(0.6)
	.bottommargin     = loExcel.inchestopoints(0.8)
	.leftmargin     = loExcel.inchestopoints(1)
	.rightmargin     = loExcel.inchestopoints(0.6)

	.headermargin     = loExcel.inchestopoints(0.1)
	.footermargin     = loExcel.inchestopoints(0.1)

	.centerhorizontally = .T.
	.Zoom = .F.
	.fittopageswide = 1
	.fittopagestall = .F.
	If Type('pcTitleRange') <> 'L'
		.printtitlerows = losheet.Range("A5:d5").address
	Endif
	If Type('pcPrintArea') <> 'L'
		.printarea = pcprintarea
	Endif
Endwith

&& Page Footer
losheet.pagesetup.rightfooter = "Page &P of &N"

*loExcel.Range("b6").Select
*loExcel.activewindow.freezepanes = .T. && freeze the panes
loExcel.Range("a1").Select

loExcel.activeworkbook.Save
loExcel.displayalerts = .F.
*loExcel.Visible = .T. && display Excel
*losheet.printpreview()
loExcel.Quit()
Release loExcel
Release All Like lo*
loExcel = .Null.

Do excel2image
Function excel2image

lcXLS ='C:\Xls\'+Alltrim(xflname)+'.xls'

If Empty(lcXLS)
	Messagebox('Excel file not found',0+16,'System')
	Return
Endif

Local oForm
oForm = Createobject("Form")

With oForm
	.Height = 550
	.Width = 360
	.AutoCenter=.T.
	.Caption=m.xflname
	.MinButton=.F.
	.MaxButton=.F.
	.AlwaysOnTop=.T.
        .Backcolor=RGB(255,255,255)
	.Newobject("ExcelObject","oleExcelObject")

	With .ExcelObject
		.Left = 10
		.Top = 10
		.Width = .Parent.Width - 30
		.Height = .Parent.Height - 30
		.Visible = .T.
	Endwith

	.Newobject("Timer1","oTimer")

Endwith

oForm.Show(1)
Define Class oleExcelObject As OleControl
	OleClass ="Excel.Sheet"
	OLETypeAllowed = 0
	DocumentFile = lcXLS
Enddefine

Define Class oTimer As Timer
	Interval=3000
	Procedure Timer
	This.Enabled = .F.
	Do ScreenShot With This.Parent
	This.Enabled = .T.
Enddefine

Procedure ScreenShot
Lparameters oForm

#INCLUDE gpImage.h

If Not "gpImage" $ Set("Procedure")
	Set Procedure To gpImage Additive
Endif

GDIP = Createobject("gpInit")
img = Createobject("gpImage")
img.Capture(oForm.HWnd)
Local lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = Sysmetric(9)
lnLeftBorder = Sysmetric(3)
lnTopBorder = Sysmetric(4)
img.Crop(lnLeftBorder, lnTitleHeight + lnTopBorder, ;
	img.ImageWidth - (lnLeftBorder * 2), ;
	img.ImageHeight - (lnTitleHeight + (lnTopBorder * 2)))
img.SaveasBMP('C:\Xls'+'\'+m.xflname)
img = Null
oForm.Release

Do image2Clip
Do send2whatsapp

Endfunc

Function image2Clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long  GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long

#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image. if used
Local m.xpict

m.xpict='C:\XLS'+'\'+m.xflname+'.bmp'


If !Empty(m.xpict)
	m.ext=Proper(Justext(m.xpict))
	If !Inlist(m.ext,"Png","Jpg","Bmp","Gif","Tif")
		Messagebox('Please select only images')
		Return
	Endif
Else
	Messagebox('Image not selected')
	Return
Endif

Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height

*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
	EmptyClipboard()
	SetClipboardData(CF_BITMAP, lhBmp)
	CloseClipboard()
Endif
Endfunc

Function send2whatsapp
* Finally send this newly created image to whatsapp
Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

Local lt, lhwnd
cPhone=[92300000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
	SetForegroundWindow (lhwnd)
	ShowWindow (lhwnd, 1)
	ox = Createobject ( "Wscript.Shell" )
	ox.SendKeys ("^{v}")
Sleep(2000)
	ox.SendKeys ( '{ENTER}' )
Else
	Messagebox ( "Whatsapp is not activated!" )
Endif
Endfunc

[URL unfurl="true"]https://res.cloudinary.com/engineering-com/image/upload/v1606822489/tips/dd2f62ba-129f-478d-8135-f13411b499df_dor8bc.bmp[/url]

You can apply more formatting to excel file to make more better look.

*---------------------------------------------------
Method:9- How to send System Generated Reports (frx)
*--------------------------------------------------

Code: 
 Clear
Set Safety Off

Public yout

Do select_frx
Do image_to_clip

Procedure select_frx
m.yrep=Getenv("TEMP")
Set Defa To (yrep)

xflname = DTOC(DATE(),1)+[_]+CHRTRAN(TIME(),[:],[]) 

m.yout=m.yrep+'\'+xflname

If !Directory(m.yout)
	Md (m.yrep+'\'+xflname)
Endi

Local afile
*afile=Getfile('frx')

&& you can this following line for testing purpose
afile=(_Samples + "\Solution\Reports\Colors.frx")

If !Empty(m.afile)
	m.ext=Lower(Justext(m.afile))
	If m.ext<>[frx]
		Messagebox('Please select only frx',0+16,'Whatsapp',3000)
		Return
	Endif
Else
	Messagebox('Report not selected',0+64,'Whatsapp',3000)
	Return
Endif

#Define OutputNothing -1
#Define OutputEMF 100
#Define OutputJPEG 102
#Define OutputGIF 103
#Define OutputPNG 104
#Define OutputBMP 105
#Define OutputTIFF 101
#Define OutputTIFFM 201

oListener =Newobject("ReportListener")
oListener.ListenerType=3
Report Form (afile) Preview Object oListener

myext=[.]+Alltrim('JPG')
ntype=OutputJPEG
m.yout=m.yout

For nPageno=1 To oListener.PageTotal
	cOutputFile = m.yout+"\myreport"+Trans(nPageno)+myext
	oListener.OutputPage(nPageno, cOutputFile,m.ntype)
Next

*!*	If Not Inlist(ntype,OutputTIFFM,1000,1001)
*!*		Run/N "explorer"  &yout
*!*	Endi

reporlistener=Null
Release ReportListener
Endproc

Procedure image_to_clip

Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long    GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long

Declare Sleep In kernel32 Integer
Declare  Integer FindWindow In WIN32API String , String
Declare  Integer SetForegroundWindow In WIN32API Integer
Declare  Integer  ShowWindow  In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
	INTEGER hndWin, ;
	STRING cAction, ;
	STRING cFileName, ;
	STRING cParams, ;
	STRING cDir, ;
	INTEGER nShowWin

#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001

fso=Createobject("scripting.filesystemobject")
fld=fso.getfolder(yout)

For Each fil In fld.Files

	Local m.oo
	m.oo=Newobject("image")
	m.oo.Picture=m.yout+"\"+(fil.Name)

	Local lnWidth,lnHeight
	lnWidth=m.oo.Width
	lnHeight=m.oo.Height

	nBitmap=0
	hbm=0
	GdipCreateBitmapFromFile(Strconv(m.yout+"\"+(fil.Name)+0h00,5),@nBitmap)
	GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
	lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
	If OpenClipboard(0)!= 0
		EmptyClipboard()
		SetClipboardData(CF_BITMAP, lhBmp)
		CloseClipboard()
	Endif

	Local lt, lhwnd
	cPhone=[923000000000]
	cmd='whatsapp://send?phone=&cPhone'
	=ShellExecute(0, 'open', cmd,'', '', 1)
	Wait "" Timeout 3
	lt = "Whatsapp"
	lhwnd = FindWindow (0, lt)
	If lhwnd!= 0
		SetForegroundWindow (lhwnd)
		ShowWindow (lhwnd, 1)
		ox = Createobject ( "Wscript.Shell" )
		ox.sendKeys ("^{v}")
		Sleep(2000)
		ox.sendKeys ( '{ENTER}' )

	Else
		Messagebox ("Whatsapp is not activated!" )
	Endif
Next

Endproc

You can use following formats with above codes
HTML,XML,TIF,EMF,JPG,GIF,PNG,BMP,DOC,XLS


Thanks Sir GriffMG and Mike Lewis for providing me support specially excel2image.

I shall welcome your feedback to make this integration more strong.

Thanks and best Regards





 
Sort by date Sort by votes
For send Whatsapp pdf with purely vfp code




pdf_filepath = "c:\sample.pdf"
DO wafoxpdf WITH pdf_filepath
Function wafoxpdf
PARAMETERS CFilepath
_cliptext = cFilepath && Path For PDF
Declare Sleep In kernel32 Integer
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll INTEGER hndWin, STRING cAction, STRING cFileName, STRING cParams, STRING cDir, INTEGER nShowWin
Local lt, lhwnd
cPhone=[919414087809]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
WAIT WINDOW "Wait For Whatsapp.." Timeout 15
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
SetForegroundWindow (lhwnd)
=INKEY(5)
FOR i=1 to 11
ox.sendkeys ("{TAB}")
=INKEY(.5)
ENDFOR
ox.sendkeys ("{ENTER}")
=INKEY(.5)
ox.sendkeys ("{UP}")
=INKEY(.5)
ox.sendkeys ("{UP}")
=INKEY(.5)
ox.sendkeys ("{ENTER}")
=INKEY(.5)
ox.sendKeys ("^{v}")
=INKEY(.5)
ox.sendkeys ("{ENTER}")
=INKEY(1)
ox.sendkeys ("{ENTER}")
=INKEY(1)
Else
Messagebox ("Whatsapp not Activated" )
Endif
 
Upvote 0 Downvote
this doesnt work

i tried setting path for my pdf file

it doesn't send
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Premal Vala
  • Question
VFP with MYSQL - mySQL server gone away
Replies
8
Views
565
Chris Miller
Chris Miller
sdocker
  • Locked
  • Question
Email automation with OUTLOOKNEW
Replies
10
Views
355
Mike Lewis
Mike Lewis
trial03
  • Question
can VFP interact with https://github.com/Nutlope/llama-ocr ?
Replies
2
Views
238
trial03
trial03
infinetecode
  • Question
VFP Report : Dynamics
Replies
4
Views
261
Chris Miller
Chris Miller
RTD78
  • Question
VFP Form Refresh
Replies
2
Views
263
RTD78
RTD78

Part and Inventory Search

Sponsor

Back
Top