[MS Office > MS Office Tools > MS Office Document Imaging]
and selecting [Tools > Options > OCR tab > OCR Language]
Now Select the text in image which are need to scrap out and right click. select any option which you want.
Friday, February 18, 2011
Wednesday, January 12, 2011
File copy code using excel macro or VBA
Const cellfilename As String = "A"
Const celldesc As String = "B"
Public Sub doc()
Dim fso_w As New Scripting.FileSystemObject
Dim fso_r As New Scripting.FileSystemObject
Dim streamRead As TextStream
Dim strdesc, strHTML, strHTMLmain, strOther, str, strAO, strShip, strAdditionalShip, strTempdesc As String
Dim strShippingPackage, strweightlbs, strweightoz, strheight, strwidth As String
Dim i, intNoImage As Integer
Dim sDesktopPath As String
Set objWSHShell = CreateObject("WScript.Shell")
sDesktopPath = objWSHShell.SpecialFolders("Desktop")
intNoImage = 0
For i = 1 To 1 '17 To 116, 117 To 216, 217 to 716
'Do not create listings that do not have any images
strHTMLmain=””
Set b = fso_r.OpenTextFile(sDesktopPath + "\New Folder\doctorcloseout\eBayDescription\eBayDescription\" + Range(cellfilename & i).Value, ForReading)
strHTMLmain = b.ReadAll
Range(celldesc & i).Value = strHTMLmain
Next i
MsgBox "done!. No images= " + CStr(intNoImage)
End Sub
Const celldesc As String = "B"
Public Sub doc()
Dim fso_w As New Scripting.FileSystemObject
Dim fso_r As New Scripting.FileSystemObject
Dim streamRead As TextStream
Dim strdesc, strHTML, strHTMLmain, strOther, str, strAO, strShip, strAdditionalShip, strTempdesc As String
Dim strShippingPackage, strweightlbs, strweightoz, strheight, strwidth As String
Dim i, intNoImage As Integer
Dim sDesktopPath As String
Set objWSHShell = CreateObject("WScript.Shell")
sDesktopPath = objWSHShell.SpecialFolders("Desktop")
intNoImage = 0
For i = 1 To 1 '17 To 116, 117 To 216, 217 to 716
'Do not create listings that do not have any images
strHTMLmain=””
Set b = fso_r.OpenTextFile(sDesktopPath + "\New Folder\doctorcloseout\eBayDescription\eBayDescription\" + Range(cellfilename & i).Value, ForReading)
strHTMLmain = b.ReadAll
Range(celldesc & i).Value = strHTMLmain
Next i
MsgBox "done!. No images= " + CStr(intNoImage)
End Sub
To remove duplicate value in excel cols (VBA Code -Excel Macros)
Const strDATA As String = "F"
Public Sub Tl_Generic()
Dim strHTMLmain, strHTML As String
Dim i, j As Integer
For i = 1 To 6
strHTMLmain = Range(strDATA & i).Value
For j = 1 To 6
If (j <> i) Then
strHTML = Range(strDATA & j).Value
If (strHTML <> "") Then
If strHTMLmain = strHTML Then
'newFLAG = Range(newLIST & i).Value
Range(strDATA & i).Value = ""
End If
End If
End If
Next j
Next i
MsgBox "done!"
End Sub
Public Sub Tl_Generic()
Dim strHTMLmain, strHTML As String
Dim i, j As Integer
For i = 1 To 6
strHTMLmain = Range(strDATA & i).Value
For j = 1 To 6
If (j <> i) Then
strHTML = Range(strDATA & j).Value
If (strHTML <> "") Then
If strHTMLmain = strHTML Then
'newFLAG = Range(newLIST & i).Value
Range(strDATA & i).Value = ""
End If
End If
End If
Next j
Next i
MsgBox "done!"
End Sub
File rename (VBA Code -Excel Macros)
Sub DoRename()
Dim i As Integer
For i = 1 To 4
Name Range("A" & i).Value As Range("B" & i).Value
Next i
End Sub
Dim i As Integer
For i = 1 To 4
Name Range("A" & i).Value As Range("B" & i).Value
Next i
End Sub
To find the presence of bulk image in local path(VBA Code -Excel Macros)
Const strIMAGE As String = "D"
Const newFLAG As String = "E"
Public Sub Tl_Generic()
Dim i As Integer
For i = 3 To 13
If Dir("" \ Range(newFLAG & i).Value) <> "" Then
Range(newFLAG & i).Value = "present"
Else
Range(newFLAG & i).Value = "missing"
End If
Next i
End Sub
Const newFLAG As String = "E"
Public Sub Tl_Generic()
Dim i As Integer
For i = 3 To 13
If Dir("
Range(newFLAG & i).Value = "present"
Else
Range(newFLAG & i).Value = "missing"
End If
Next i
End Sub
To find duplicate element in excel cols (VBA Code -Excel Macros)
Const strDATA As String = "D"
Const newLIST As String = "E"
Public Sub Tl_Generic()
Dim strHTMLmain, strHTML, newFLAG As String
Dim i, j As Integer
For i = 3 To 13
Range(newLIST & i).Value = ""
strHTMLmain = Range(strDATA & i).Value
For j = 3 To 13
strHTML = Range(strDATA & j).Value
If strHTMLmain = strHTML Then
newFLAG = Range(newLIST & i).Value
Range(newLIST & i).Value = newFLAG & "-" & j
End If
Next j
Next i
MsgBox "done!"
End Sub
Const newLIST As String = "E"
Public Sub Tl_Generic()
Dim strHTMLmain, strHTML, newFLAG As String
Dim i, j As Integer
For i = 3 To 13
Range(newLIST & i).Value = ""
strHTMLmain = Range(strDATA & i).Value
For j = 3 To 13
strHTML = Range(strDATA & j).Value
If strHTMLmain = strHTML Then
newFLAG = Range(newLIST & i).Value
Range(newLIST & i).Value = newFLAG & "-" & j
End If
Next j
Next i
MsgBox "done!"
End Sub
Code to count the tag in html page (VBA Code -Excel Macros)
Dim iCount As Integer
Sub findit()
Dim str As String
Dim iLen, iRes As Integer
iLen = Len(str)
For i = 2 To 557
str = Range("D" & i).Value
iCount = 0
iRes = howmany(str, " Range("M" & i).Value = iCount
Next i
End Sub
Function howmany(str As String, sSearch As String, iStart As Integer)
Dim iTemp, iRes As Integer
iTemp = InStr(iStart, str, sSearch)
iStart = iTemp
If iTemp = 0 Then
howmany = iCount
Else
iCount = iCount + 1
iTemp = howmany(str, sSearch, iStart + 1)
End If
End Function
Sub findit()
Dim str As String
Dim iLen, iRes As Integer
iLen = Len(str)
For i = 2 To 557
str = Range("D" & i).Value
iCount = 0
iRes = howmany(str, " Range("M" & i).Value = iCount
Next i
End Sub
Function howmany(str As String, sSearch As String, iStart As Integer)
Dim iTemp, iRes As Integer
iTemp = InStr(iStart, str, sSearch)
iStart = iTemp
If iTemp = 0 Then
howmany = iCount
Else
iCount = iCount + 1
iTemp = howmany(str, sSearch, iStart + 1)
End If
End Function
To filter a column from other column (c=a-b) in excel (VBA Code -Excel Macros)
Const pic As String = "GU"
Const newdes As String = "GV"
Const cellDescription As String = "GS"
Public Sub TL_Generic()
Dim strHTMLmain, strHTML As String
Dim i As Integer
For i = 2 To 2979
strHTMLmain = Range(cellDescription & i).Value
strHTML = strHTMLmain
strHTML = Replace(strHTML, (Range(pic & i).Value), "")
Range(newdes & i).Value = strHTML
conti:
Next i
MsgBox "done!"
End Sub
Const newdes As String = "GV"
Const cellDescription As String = "GS"
Public Sub TL_Generic()
Dim strHTMLmain, strHTML As String
Dim i As Integer
For i = 2 To 2979
strHTMLmain = Range(cellDescription & i).Value
strHTML = strHTMLmain
strHTML = Replace(strHTML, (Range(pic & i).Value), "")
Range(newdes & i).Value = strHTML
conti:
Next i
MsgBox "done!"
End Sub
Subscribe to:
Posts (Atom)

