How to get r to read 'date taken' of a JPG file - r

I could use some help performing a database correction, in regards to date and time of pictures were taken.
Essentially, the research we perform entails taking many pictures and entering the picture information into a database (we automated this with Microsoft Access). However, I performed a random check of our database and found that several dates and times of the photos were incorrect, and I am attempting to correct this via R as I was unable to correct it via Access.
What I need to do is to is write a script that reads these data, and compiles a list of the date taken information for all photos (there are several thousand). So far the best thing that I've found is
file.info(list.files(
"E:/Whatcom Creek Project/Data/Seal photos/Discovery/Catalog/Phoca vitulina",
recursive = T))
However this returns a list of NA NA for all information. Also, if I manually select one image to run file.info on, it doesn't return date taken (see the picture for the data I am attempting to retrieve)
If anyone has any suggestions I am all ears. Thanks in advance!!
-Ian
enter image description here

maybe still of any use?
i saw this message. I solved this a long time ago (2011) with a very basic VB6 code. The job is still working, but it is not applicable to all '.jpg files'. It depends with what camera the picture has been taken, but mostly pictures taken from a smartphone and classic camera's are returning the date the picture has been taken (not usable for whatsapp images or edited images).
The code is here below, and it is very basic code (but i hope it still can help or give idea's, and ... any new idea's are welcome too) :
'Reading of "Date Picture Taken" from .jpg file
'-----------------------------------------------
Debug.Print ">>>>>==== Start Read of .jpg-file ===== "; Date; " ===== "; Time; " ====<<<<<"
X = 0
DatePictureTaken = ""
TimePictureTaken = ""
FOUNDdatum = False
SWdatum = False
TELdatum = 0
Foto = FOLDER & "\" & tabFileName(FotoNr)
Open Foto For Binary Access Read As #1
'get startposition of the field "date picture taken"
Do
X = X + 1
Get #1, X, MyByte ': Debug.Print Chr(MyByte);
DoEvents
If Chr(MyByte) = ":" Then
'Debug.Print
SWdatum = True
Get #1, X + 3, MyByte
'Debug.Print "x+03="; Chr(MyByte)
If Chr(MyByte) <> ":" Then SWdatum = False 'Debug.Print "x+03="; Chr(MyByte)
Get #1, X + 9, MyByte
'Debug.Print "x+09="; Chr(MyByte)
If Chr(MyByte) <> ":" Then SWdatum = False 'Debug.Print "x+09="; Chr(MyByte)
Get #1, X + 12, MyByte
'Debug.Print "x+12="; Chr(MyByte)
If Chr(MyByte) <> ":" Then SWdatum = False 'Debug.Print "x+12="; Chr(MyByte)
'if a ':' is on the 3 locations (found above) then it is a date!
If SWdatum _
Then
TELdatum = TELdatum + 1
End If
'the 3e date is the date the picture has been taken
If TELdatum = 3 _
Then
FOUNDdatum = True
X = X - 4
Exit Do
End If
X = X + 12
End If
Loop Until EOF(1) 'Or X = 32765
If FOUNDdatum = False Then Close 1: End
BPdatum = X
EPdatum = X + 9
BPuur = X + 11
EPuur = X + 15
For X = BPdatum To EPdatum
Get #1, X, MyByte
'Debug.Print Chr(MyByte)
If Chr(MyByte) <> ":" _
Then
' DatePictureTaken = DatePictureTaken & "/"
'Else
DatePictureTaken = DatePictureTaken & Chr(MyByte)
End If
Next X
For X = BPuur To EPuur
Get #1, X, MyByte
'Debug.Print Chr(MyByte)
If Chr(MyByte) <> ":" _
Then
' DatePictureTaken = DatePictureTaken & "/"
'Else
TimePictureTaken = TimePictureTaken & Chr(MyByte)
End If
Next X
'Debug.Print "Date Picture Taken = "; DATUM
tbxDatum.Text = DatePictureTaken
tbxUur.Text = TimePictureTaken
Close 1
End Sub

Related

VBScript - Date and Time Constraints for Running a File

Ok I am new with writing VBScript and I want to write a string of code that plays a file (WAV format) only on a certain day and only between specific times. After piecing together multiple fragments of code I found on the internet I was left with the following:
Dim myDateString
Dim thing1
thing1 = 0
myDateString = Date()
If myDateString < "13/08/13" Then
thing1 = 1
end if
if thing1 = 1 then
If myDateString > "15/08/13" Then
thing1 = 2
end if
end if
if thing1 = 2 then
hournow = hour(Time())
If hour(Time()) >= 9 And Hour(Now()) < 22 Then
set WshShell = CreateObject("WScript.Shell")
music = "C:\Users\MYUSERNAME\Desktop\MYSOUND.wav"
WshShell.Run "wmplayer """ & music & """",0,True
Else
wscript.quit 1
End If
Else
wscript.quit 1
End If
Ok so I had set this for the date I ran this on, within the hour I was in. But
it didn't work. I expected the VBS to start playing MYSOUND.wav but it didn't. When running the file
there were no errors though, so I was wondering what I did wrong!
I running Windows 7
If anyone could tell me what I did wrong, and how to fix it that would be great.
Double points if anyone could post a corrected version of the code!
Thanks to any answers!
First, indent your code and give your variables meaningful names!
Then, your date comparison doesn't work because you're trying to compare strings as if they were dates. This usually won't work (depending on your "system locale"): you need to use date type variables and an actual date comparison function (DateDiff in VBScript).
(EDIT: as Ansgar Wiechers pointed out, you don't need to use DateDiff to compare dates in VBScript, "DateStart <= Now And Now <= DateEnd" will do just fine)
Try this:
Dim DateStart, DateEnd, WshShell, music
DateStart = DateSerial(2013, 8, 13)
DateEnd = DateSerial(2013, 8, 15)
If DateDiff("D", DateStart, Now) >= 0 And DateDiff("D", Now, DateEnd) >= 0 Then
If Hour(Now) >= 9 And Hour(Now) < 22 Then
'*** delete after debugging ***
MsgBox "play sound"
Set WshShell = CreateObject("WScript.Shell")
music = "C:\Users\MYUSERNAME\Desktop\MYSOUND.wav"
'*** 2nd parameter : 0 hides wmplayer, 1 shows it ***
WshShell.Run "wmplayer """ & music & """", 1, True
Else
'*** delete after debugging ***
MsgBox "Not the right time"
End If
Else
'*** delete after debugging ***
MsgBox "Not the right day"
End If
Also, if you want to debug a small script like this, you can call MsgBox to do a simple tracking of what's actually executed (in your example, replacing your "WScript.Quit 1" by MsgBox would show you that the date is not properly compared.

Compiling individual webpage tables into a single Excel readable table

I would like to create a master list of contact information for all Chiropractors in Arizona. The board website lists all the Chiropractors here however, I have to click through to see each individual address and phone number.
How can I get all of the information about each Chiropractor in to a single spreadsheet row format?
This is easy. In your first sheet do Data > External data > From website. Paste the URL, select the main table and do Next and put it in A1.
In VBA Editor paste the following formula and execute it. It will retrieve all data from the website and paste it in Sheet2. The rest is just reorganizing the data which is not the topic of your question so I leave it up to you.
Sub ExtractAllData()
Dim dest As Range, license As Range
Dim license_no As String
Worksheets("Feuil2").Select
Set dest = Worksheets("Feuil2").Range("A1")
Set license = Worksheets("Feuil1").Range("C3")
Do Until license.Value = ""
license_no = Mid(license.Value, 1, InStr(1, license.Value, " "))
With Worksheets("Feuil2").QueryTables.Add(Connection:= _
"URL;http://www.azchiroboard.us/ProDetail.asp?LicenseNo=" & license_no, Destination:= _
dest)
.Name = "ProDetail.asp?LicenseNo=" & license_no
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "1"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Set dest = Range("A65535").End(xlUp)
Set dest = dest.Offset(1, 0)
Set license = license.Offset(1, 0)
Loop
End Sub
For the record, it took me 1 minute to figure out how to retrieve the data from the main table. 1 minute to figure out that the link just calls a PHP page with the license number. 1 minute to record the macro and then 5 minutes to adapt it and fix errors I had made.

Highlight keywords in classic ASP

I have this sentense, "The man went outside".
I also have 4 search criterias I would like to get highligted (ignore the brackets), [went|"an WeNT o"|a|t] with [span id="something"][/span].
I have tried out a lot of stuff but I can't figure out how to do this in classic ASP!? If I insert a somewhere in the text, it will search the HTML code for SPAN too, which is bad or it will not find the text as it has been messed up with HTML code. I also tried inserting on all positions in the original text and even with some magic regular expression which I do not understand but I can't get this working :-/
The search-thing is divided with | and can be anything from 1 to 20 things to search for.
Can anyone help me solving how to do this?
I found and tweaked some code and it works perfectly for me:
Function highlightStr (haystack, needles)
' Taken (and tweaked) from these two sites:
' http://forums.aspfree.com/asp-development-5/asp-highlight-keywords-295641.html
' http://www.eggheadcafe.com/forumarchives/scriptingVisualBasicscript/Jul2005/post23377133.asp
'
' INPUT: haystack = search in this string
' INPUT: needles = searches divided by |... example: this|"is a"|search
' OUTPUT: HTML formatted highlighted string
'
If Len(haystack) > 0 Then
' Delete the first and the last array separator "|" (if any)
If Left(needles,1) = "|" Then needles = Right(needles,Len(needles)-1)
If Right(needles,1) = "|" Then needles = Mid(needles,1,Len(needles)-1)
' Delete a multiple seperator (if any)
needles = Replace(needles,"||","|")
' Delete the exact-search chars (if any)
needles = Replace(needles,"""","")
' Escape all special regular expression chars
needles = Replace(needles,"(","\(")
needles = Replace(needles,")","\)")
needles = Replace(needles,".","\.")
If Len(needles) > 0 Then
haystack = " " & haystack & " "
Set re = New RegExp
re.Pattern = "(" & needles & ")"
re.IgnoreCase = True
re.Global = True
highlightStr = re.Replace(haystack,"<span style='background-color:khaki;'>$&</span>")
Else
highlightStr = haystack
End If
Else
highlightStr = haystack
End If
End Function

writing csv adds extra lines

I've to write a csv for a third-party upload. They're saying they can't read the csv file created because it has two extra lines of code and doesn't end (when opened in Notepad) on the last character of the last line. That's true - but can anyone tell me why?
Dim _csvLine As New System.IO.StreamWriter(Server.MapPath("~/folder/_" & rptType.SelectedItem.Value.ToString & ".csv"), False)
Dim tb As New StringBuilder
Dim x As Integer = ds.Tables("csv").Columns.Count, y As Integer = 1
For Each row As Data.DataRow In ds.Tables("csv").Rows
For Each col As Data.DataColumn In ds.Tables("csv").Columns
If y <> x Then
tb.Append(Trim(System.Text.RegularExpressions.Regex.Replace(row.Item(col).ToString, "\s+", " ", RegexOptions.IgnoreCase Or RegexOptions.Multiline)) & ",")
y = y + 1
Else
tb.Append(Trim(System.Text.RegularExpressions.Regex.Replace(row.Item(col).ToString, "\s+", " ", RegexOptions.IgnoreCase Or RegexOptions.Multiline)))
tb.AppendLine()
y = 1
End If
Next
Next
_csvLine.WriteLine(Left(tb.ToString, Len(tb.ToString) - 2))
_csvLine.Flush()
_csvLine.Close()
_csvLine.Dispose()
One line is appended by _csvLine.WriteLine, use Write() instead.
tb.AppendLine() adds the second line, try avoiding it on the last line.
You're doing _csvLine.WriteLine( which is gonna add a linebreak to the end of the file.

radio button list selectedItem.Value not working when compared to a string

I am using VB.NET and I can't compare the radio button lists selectedItem.Value to a string, it doesn't work...here is the code: (I have also tried selectedValue it does not work either)
Response.Write("RB1: " + rblOne.SelectedItem.Value + " FML FML FML<br/>")
If rblOne.SelectedItem.Value = "No" Then
Response.Write("Hey there!<BR/>")
pnlR1.Visible = True
If NumberOfAnswers = 7 Then
Score = Score - 10
ElseIf NumberOfAnswers = 6 Then
Score = Score - 15
Else
Score = Score - 20
End If
Response.Write("Score: " + Score.ToString)
End If
Response.End()
If rblOne.SelectedItem.Value = "No" Then is not working, notice the debug statements in there, here is the output:
Why won't it evaluate that rblOne.SelectedItem.Value = "No" !?!?!? I tried rblOne.SelectedValue, that doesn't work, AND I added .ToString to both, which did not help, I even tried it w/ "No".ToString...this doesn't make any sense.
If rblOne.SelectedIndex > -1 AndAlso rblOne.Items(rblOne.SelectedIndex).Value.ToString = "No" Then
'Code to run if the selected list item in the radio button list has a value of "No"
End If

Resources