اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

وعليكم السلام 

اتفضل الكود دا لعله يكون المطلوب جرب وشوف وخبرنا بالنتجه 

Option Explicit

Sub ارسال_رسائل_واتساب()

    Dim ws As Worksheet
    Dim LastRow As Long
    Dim i As Long
    
    Dim Phone As String
    Dim Name As String
    Dim Msg As String
    
    Set ws = ThisWorkbook.Sheets("رسائل اليوم")
    
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To LastRow
    
        Name = Trim(ws.Cells(i, "A").Value)
        Phone = Trim(ws.Cells(i, "C").Value)
        Msg = Trim(ws.Cells(i, "E").Value)
        
        If Phone <> "" And Msg <> "" Then
        
            Msg = Replace(Msg, "[الاسم]", Name)
            Msg = WorksheetFunction.EncodeURL(Msg)
            
            ThisWorkbook.FollowHyperlink _
            "https://web.whatsapp.com/send?phone=" & Phone & "&text=" & Msg
            
            Application.Wait Now + TimeValue("00:00:08")
            
            SendKeys "~", True
            
            Application.Wait Now + TimeValue("00:00:03")
            
        End If
        
    Next i
    
    MsgBox "تم إرسال جميع الرسائل", vbInformation

End Sub

وممكن حضرتك تتصفح المواضيع اللي تحت👇 ينمكن تلاقي اللي بتدور عليه وأكتر كما🌹

 

 

Copy of واتس اب ويب.xlsm

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information