Coding VB 6.0 and VB.Net: 2016

Friday, December 16, 2016

VBA pdf export from excel

//developer tab for create button, alt+f11 for vba open

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

Thursday, December 1, 2016

EXPORT TO EXCEL Visual Studio 2015

//go to project -> add reference -> Microsoft office 16.0 object library and Microsoft Excel Library

// Imports Excel = Microsoft.Office.Interop.Excel
// copy paste this code for EXPORT BUTTON

Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlWorkBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer

xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")

For i = 0 To DataGridView1.RowCount - 2
For j = 0 To DataGridView1.ColumnCount - 1
For k As Integer = 1 To DataGridView1.Columns.Count
xlWorkSheet.Cells(1, k) = DataGridView1.Columns(k - 1).HeaderText
xlWorkSheet.Cells(i + 2, j + 1) = DataGridView1(j, i).Value.ToString()
Next
Next
Next

xlWorkSheet.SaveAs("C:\vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()

releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)

MsgBox("You can find the file C:\vbexcel.xlsx")
End Sub

Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub

Friday, May 27, 2016

Google Map as a background HTML

//copy and paste this code in your html page

<!DOCTYPE html>
<html>
<head>

<title></title>
<meta charset="utf-8" />

<style type="text/css" >

#googlemaps {
height: 100%;
width: 100%;
position:absolute;
top: 0;
left: 0;
z-index: 0; /* Set z-index to 0 as it will be on a layer below the contact form */
}

#contactform {
position: relative;
z-index: 1; /* The z-index should be higher than Google Maps */
width: 250px;
margin: 5px auto 0 770px;
padding: 5px;
background: coral;
height: auto;
opacity: .80; /*Set the opacity for a slightly transparent Google Form*/
color:white;

text-align:center ;
}

</style>
</head>
<body>
<div id="googlemaps"></div>
<div id="contactform">
<h2>NOIDA</h2>

<p style="font-family:Calibri;">
A-10 A, Sector – 68, Noida-201301,<br />
District – Gautam Budh Nagar,<br />
Uttar Pradesh, INDIA<br />
+91-120-6759600<br />
cylmktg@afflatusfravure.com<br />
</p>
</div>

</body>

</html>

<script src="http://maps.googleapis.com/maps/api/js?sensor=false"></script>

<script type="text/javascript">

// The latitude and longitude of your business / place
var position = [28.6046998, 77.3900557];

function showGoogleMaps() {

var latLng = new google.maps.LatLng(position[0], position[1]);

var mapOptions = {
zoom: 16, // initialize zoom level - the max value is 21
streetViewControl: false, // hide the yellow Street View pegman
scaleControl: true, // allow users to zoom the Google Map
mapTypeId: google.maps.MapTypeId.ROADMAP,
center: latLng
};

map = new google.maps.Map(document.getElementById('googlemaps'),
mapOptions);

// Show the default red marker at the location
marker = new google.maps.Marker({
position: latLng,
map: map,
draggable: false,
animation: google.maps.Animation.DROP
});
}
google.maps.event.addDomListener(window, 'load', showGoogleMaps);

</script>

// you have to just change the co-ordinates

Find your co-ordinates here

Sunday, May 15, 2016

Website CAREER FORM with send mail,attached resume and linked resume

Imports System.Data.OleDb
Imports System.Data
Imports System.Web.Configuration
Imports System.Web.UI.HtmlControls.HtmlGenericControl
Imports System.Web.HttpApplication
Imports System.Drawing
Imports System.Net.Mail

Dim mail As New MailMessage()
mail.From = New MailAddress("" & txtemail.Text & "")
mail.To.Add("kapil@afflatusgravure.com")

Dim sb As New StringBuilder
FileUpload1.SaveAs(Server.MapPath("~/RESUMES/") & FileUpload1.FileName)
Dim file As String = (Server.MapPath("~/RESUMES/") & FileUpload1.FileName)
sb.Append("<a href=" & file & ">" & txtname.Text & "_" & "RESUME</a>")
mail.Subject = ddlist1.Text
mail.Body = "Name:" & " " & txtname.Text & "<br/>" & "Mobile:" & " " & txtmobile.Text & "<br/>" & "E-Mail:" & " " & txtemail.Text & "<br/>" & "Date Of Birth:" & " " & txtdob.Text & " <br/>" & "Applied For:" & " " & ddlist1.Text & "<br/>" & "Qualification:" & " " & txtqualification.Text & "<br/>" & "Skills:" & " " & txtskills.Text & "<br/>" & "Experience:" & " " & txtexperience.Text & "<br/>" & "Remarks:" & " " & txtremarks.Text & "<br/>" & "Resume:" & " " & sb.ToString()

mail.IsBodyHtml = True

//if u want ATTACHED RESUME with mail

'If Not file = "" Then
' Dim MsgAttach As New Attachment(file)
' mail.Attachments.Add(MsgAttach)
'End If

Dim smtp As New SmtpClient("103.245.119.210")
smtp.Send(mail)

Image1.Visible = True
txtdob.Text = ""
txtemail.Text = ""
txtexperience.Text = ""
txtmobile.Text = ""
txtname.Text = ""
txtqualification.Text = ""
txtremarks.Text = ""
txtskills.Text = ""

//FOR ACCEPT DOC/MSWORD ONLY with fileupload control

If (
FileUpload1.PostedFile.ContentType = "text/rtf" Or
FileUpload1.PostedFile.ContentType = "application/doc" Or
FileUpload1.PostedFile.ContentType = "appl/text" Or
FileUpload1.PostedFile.ContentType = "application/vnd.msword" Or
FileUpload1.PostedFile.ContentType = "application/vnd.ms-word" Or
FileUpload1.PostedFile.ContentType = "application/winword" Or
FileUpload1.PostedFile.ContentType = "application/word" Or
FileUpload1.PostedFile.ContentType = "application/msword" Or
FileUpload1.PostedFile.ContentType = "application/x-msw6" Or
FileUpload1.PostedFile.ContentType = "application/x-msword"
) Then

Tuesday, April 26, 2016

Getting Information About Public users IP Location

Imports System.IO
Imports System.Net
Imports System.String

Dim strClientIP As String
strClientIP = Request.UserHostAddress()

Dim strComputerName As String
Dim host As System.Net.IPHostEntry
host = System.Net.Dns.GetHostEntry(Request.ServerVariables.Item("REMOTE_HOST"))
strComputerName = host.HostName

Dim ExternalIP As String
ExternalIP = (New WebClient()).DownloadString("http://checkip.dyndns.org/")
ExternalIP = (New Regex("\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}")) _
.Matches(ExternalIP)(0).ToString()

Dim FILENAME As String = Server.MapPath("IP.txt")
Dim objStreamWriter As StreamWriter
objStreamWriter = File.AppendText(FILENAME)
objStreamWriter.WriteLine("External IP :" & " " & ExternalIP)
objStreamWriter.WriteLine("Computer Name :" & " " & strComputerName)
objStreamWriter.WriteLine("Local IP :" & " " & strClientIP)
objStreamWriter.WriteLine("Date & Time :" & " " & DateTime.Now)
objStreamWriter.WriteLine("-----------------------------------------------------")
objStreamWriter.Close()
Dim objStreamReader As StreamReader
objStreamReader = File.OpenText(FILENAME)
Dim contents As String = objStreamReader.ReadToEnd()
objStreamReader.Close()

Disable Copy Text From Web Pages

// copy paste this script inside head section of page OR contentplaceholder's head content

<script type="text/javascript">

function disableSelection(target){
if (typeof target.onselectstart!="undefined") //IE route
target.onselectstart=function(){return false}
else if (typeof target.style.MozUserSelect!="undefined") //Firefox route
target.style.MozUserSelect="none"
else //All other route (ie: Opera)
target.onmousedown=function(){return false}
target.style.cursor = "default"
}

</script>

//Then copy paste these scripts according usage inside body section OR contentplaceholder

<script type="text/javascript">
disableSelection(document.body) //disable text selection on entire body of page
</script>

<script type="text/javascript">
var somediv=document.getElementById("mydiv")
disableSelection(somediv) //disable text selection within DIV with id="mydiv"
</script>

<script type="text/javascript">
var alltables=document.getElementsByTagName("table")
for (var i=0; i<alltables.length; i++)
disableSelection(alltables[i]) //disable text selection within all tables on the page
</script>

Disable Right Click On Web Pages

// copy and paste this code inside your body section OR contentplaceholder

<script language=JavaScript>

</script>

Disable Right Click on Images

// copy and paste this script inside your body section OR contentplaceholder

<script>

document.oncontextmenu = function(e){
var target = (typeof e !="undefined")? e.target: event.srcElement
if (target.tagName == "IMG" || (target.tagName == 'A' && target.firstChild.tagName == 'IMG'))
return false
}

</script>

Tuesday, April 12, 2016

SQL- See Table RelationShips

//RUN QUERY IN SQL

SELECT
K_Table = FK.TABLE_NAME,
FK_Column = CU.COLUMN_NAME,
PK_Table = PK.TABLE_NAME,
PK_Column = PT.COLUMN_NAME,
Constraint_Name = C.CONSTRAINT_NAME
FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS C
INNER JOIN INFORMATION_SCHEMA.TABLE_CONSTRAINTS FK ON C.CONSTRAINT_NAME = FK.CONSTRAINT_NAME
INNER JOIN INFORMATION_SCHEMA.TABLE_CONSTRAINTS PK ON C.UNIQUE_CONSTRAINT_NAME = PK.CONSTRAINT_NAME
INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE CU ON C.CONSTRAINT_NAME = CU.CONSTRAINT_NAME
INNER JOIN (
SELECT i1.TABLE_NAME, i2.COLUMN_NAME
FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS i1
INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE i2 ON i1.CONSTRAINT_NAME = i2.CONSTRAINT_NAME
WHERE i1.CONSTRAINT_TYPE = 'PRIMARY KEY'
) PT ON PT.TABLE_NAME = PK.TABLE_NAME

Sunday, April 10, 2016

Using Date & Time in EXCEL

https://www.ablebits.com/office-addins-blog/2015/06/24/calculate-time-excel/

Friday, April 8, 2016

Link Any Type Of File as OBJECT

Wednesday, March 16, 2016

TITLE MARQUEE

//

Monday, March 14, 2016

Display name with mouse cursor

// Copy and Paste Script in your head section

<style type="text/css">

/* Circle Text Styles */

#outerCircleText {

/* Optional - DO NOT SET FONT-SIZE HERE, SET IT IN THE SCRIPT */

font-style: italic;

font-weight: bold;

font-family: 'comic sans ms', verdana, arial;

color: #000;

/* End Optional */

/* Start Required - Do Not Edit */

position: absolute;top: 0;left: 0;z-index: 3000;cursor: default;}

#outerCircleText div {position: relative;}

#outerCircleText div div {position: absolute;top: 0;left: 0;text-align: center;}

/* End Required */

/* End Circle Text Styles */

</style>

<script type="text/javascript">

/* Circling text trail- Tim Tilton

Website: http://www.tempermedia.com/

Visit: http://www.dynamicdrive.com/ for Original Source and tons of scripts

Modified Here for more flexibility and modern browser support

Modifications as first seen in http://www.dynamicdrive.com/forums/

username:jscheuer1 - This notice must remain for legal use

*/

;(function(){

// Your message here (QUOTED STRING)

var msg = "Dynamic Drive! Scripts & More!";

/* THE REST OF THE EDITABLE VALUES BELOW ARE ALL UNQUOTED NUMBERS */

// Set font's style size for calculating dimensions

// Set to number of desired pixels font size (decimal and negative numbers not allowed)

var size = 24;

// Set both to 1 for plain circle, set one of them to 2 for oval

// Other numbers & decimals can have interesting effects, keep these low (0 to 3)

var circleY = 0.75; var circleX = 2;

// The larger this divisor, the smaller the spaces between letters

// (decimals allowed, not negative numbers)

var letter_spacing = 5;

// The larger this multiplier, the bigger the circle/oval

// (decimals allowed, not negative numbers, some rounding is applied)

var diameter = 10;

// Rotation speed, set it negative if you want it to spin clockwise (decimals allowed)

var rotation = 0.4;

// This is not the rotation speed, its the reaction speed, keep low!

// Set this to 1 or a decimal less than one (decimals allowed, not negative numbers)

var speed = 0.3;

////////////////////// Stop Editing //////////////////////

if (!window.addEventListener && !window.attachEvent || !document.createElement) return;

msg = msg.split('');

var n = msg.length - 1, a = Math.round(size * diameter * 0.208333), currStep = 20,

ymouse = a * circleY + 20, xmouse = a * circleX + 20, y = [], x = [], Y = [], X = [],

o = document.createElement('div'), oi = document.createElement('div'),

b = document.compatMode && document.compatMode != "BackCompat"? document.documentElement : document.body,

mouse = function(e){

e = e || window.event;

ymouse = !isNaN(e.pageY)? e.pageY : e.clientY; // y-position

xmouse = !isNaN(e.pageX)? e.pageX : e.clientX; // x-position

},

makecircle = function(){ // rotation/positioning

if(init.nopy){

o.style.top = (b || document.body).scrollTop + 'px';

o.style.left = (b || document.body).scrollLeft + 'px';

};

currStep -= rotation;

for (var d, i = n; i > -1; --i){ // makes the circle

d = document.getElementById('iemsg' + i).style;

d.top = Math.round(y[i] + a * Math.sin((currStep + i) / letter_spacing) * circleY - 15) + 'px';

d.left = Math.round(x[i] + a * Math.cos((currStep + i) / letter_spacing) * circleX) + 'px';

};

},

drag = function(){ // makes the resistance

y[0] = Y[0] += (ymouse - Y[0]) * speed;

x[0] = X[0] += (xmouse - 20 - X[0]) * speed;

for (var i = n; i > 0; --i){

y[i] = Y[i] += (y[i-1] - Y[i]) * speed;

x[i] = X[i] += (x[i-1] - X[i]) * speed;

};

makecircle();

},

init = function(){ // appends message divs, & sets initial values for positioning arrays

if(!isNaN(window.pageYOffset)){

ymouse += window.pageYOffset;

xmouse += window.pageXOffset;

} else init.nopy = true;

for (var d, i = n; i > -1; --i){

d = document.createElement('div'); d.id = 'iemsg' + i;

d.style.height = d.style.width = a + 'px';

d.appendChild(document.createTextNode(msg[i]));

oi.appendChild(d); y[i] = x[i] = Y[i] = X[i] = 0;

};

o.appendChild(oi); document.body.appendChild(o);

setInterval(drag, 25);

},

ascroll = function(){

ymouse += window.pageYOffset;

xmouse += window.pageXOffset;

window.removeEventListener('scroll', ascroll, false);

};

o.id = 'outerCircleText'; o.style.fontSize = size + 'px';

if (window.addEventListener){

window.addEventListener('load', init, false);

document.addEventListener('mouseover', mouse, false);

document.addEventListener('mousemove', mouse, false);

if (/Apple/.test(navigator.vendor))

window.addEventListener('scroll', ascroll, false);

}

else if (window.attachEvent){

window.attachEvent('onload', init);

document.attachEvent('onmousemove', mouse);

};

})();

</script>

Wednesday, March 2, 2016

SEND EMAIL SIMPLE VB.NET

//function

Public Shared Sub SendMail(ByVal from As String, ByVal [to] As String, ByVal subject As String, ByVal body As String, ByVal smtpServer As String, ByVal smtpUsername As String, _
ByVal smtpPassword As String)
Dim message As New MailMessage(from, [to], subject, body)
Dim smtpClient As New SmtpClient(smtpServer)
smtpClient.UseDefaultCredentials = False
Dim credentials As New NetworkCredential(smtpUsername, smtpPassword)
smtpClient.Credentials = credentials
smtpClient.Send(message)
End Sub

//call on button click

Protected Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
SendMail("kapil@suprol.com", "kapil@suprol.com", "hello", "body", "192.168.1.123", "kapil@suprol.com", "suprol")

End Sub

Coding VB 6.0 and VB.Net