テックメモ – ページ 56 – 自分用のメモです。内容が間違っていたり、作りかけで動作しないコードなどあるのでご注意ください。

2016-09-272020-01-16

VBA フォルダ・ファイルのリンクの一覧

業務上のファイルをフォルダ管理している中小企業は多いと思います。業務別にフォルダを作っていたり、個人別にフォルダを作っていたり。

フォルダやファイルにエクセルからアクセスできると便利かと思い作成してみた。

Sub auto_open()
 
'参照設定　Microsoft Scripting Runtime

On Error Resume Next
 
Application.CommandBars("cell").Controls("作成").Delete
Application.CommandBars("cell").Controls("作成").Delete
 
With Application.CommandBars("cell").Controls.Add
  .Caption = "作成"
  .OnAction = "main"
End With
 
End Sub

Sub auto_close()
 
On Error Resume Next
 
Application.CommandBars("cell").Controls("作成").Delete
Application.CommandBars("cell").Controls("作成").Delete
 
End Sub

Sub main()
    
ActiveSheet.Cells.ClearContents
ActiveSheet.Cells.ColumnWidth = 5

Dim obj As FileSystemObject
Set obj = New FileSystemObject

Call func(obj.GetFolder(ActiveWorkbook.Path), 0, 0)

Set obj = Nothing
 
End Sub
 
Sub func(ByVal f As Folder, ByRef r As Long, ByVal c As Long)
 
r = r + 1
c = c + 1

ActiveSheet.Cells(r, c).Value = f.Name
ActiveSheet.Hyperlinks.Add anchor:=Cells(r, c), Address:=f.Path

Dim k As Folder

For Each k In f.SubFolders
  Call func(k, r, c)
Next k

c = c + 1

Dim i As File

For Each i In f.Files
    
  If 0 = InStr(i.Name, ActiveWorkbook.Name) Then
  
    r = r + 1
    
    ActiveSheet.Cells(r, c).Value = i.Name
    ActiveSheet.Hyperlinks.Add anchor:=Cells(r, c), Address:=i.Path

  End If

Next i

Set f = Nothing
    
End Sub

Sub auto_open()

'参照設定　Microsoft Scripting Runtime

On Error Resume Next

Application.CommandBars("cell").Controls("作成").Delete

With Application.CommandBars("cell").Controls.Add

.Caption = "作成"

.OnAction = "main"

End With

End Sub

Sub auto_close()

On Error Resume Next

Application.CommandBars("cell").Controls("作成").Delete

End Sub

Sub main()

ActiveSheet.Cells.ClearContents

ActiveSheet.Cells.ColumnWidth = 5

Dim obj As FileSystemObject

Set obj = New FileSystemObject

Call func(obj.GetFolder(ActiveWorkbook.Path), 0, 0)

Set obj = Nothing

End Sub

Sub func(ByVal f As Folder, ByRef r As Long, ByVal c As Long)

r = r + 1

c = c + 1

ActiveSheet.Cells(r, c).Value = f.Name

ActiveSheet.Hyperlinks.Add anchor:=Cells(r, c), Address:=f.Path

Dim k As Folder

For Each k In f.SubFolders

Call func(k, r, c)

Next k

c = c + 1

Dim i As File

For Each i In f.Files

If 0 = InStr(i.Name, ActiveWorkbook.Name) Then

r = r + 1

ActiveSheet.Cells(r, c).Value = i.Name

ActiveSheet.Hyperlinks.Add anchor:=Cells(r, c), Address:=i.Path

End If

Next i

Set f = Nothing

End Sub

2016-09-27

VBA IEを起動して検索順位を調べる

特定のワードでドメインが何番目のページにいるかを知りたいときに。
A列にドメイン名、B列にキーワードを入れて使う。

'参照設定
'Microsoft HTML Object Library
'Microsoft Internet Controls

#If VBA7 Then
  Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
  Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

Sub ieWait(obj As InternetExplorer)

Do While obj.Busy = True Or obj.ReadyState <> 4
  DoEvents
  Sleep 1000
Loop

Do While obj.document.ReadyState <> "complete"
  DoEvents
  Sleep 1000
Loop

Sleep Int((3000 - 1000 + 1) * Rnd + 1000)

End Sub

Sub auto_open()

Application.CommandBars("cell").Reset

With Application.CommandBars("cell").Controls.Add

  .OnAction = "main"
  .Caption = "KeyCheck"

End With

End Sub

Sub auto_close()

On Error Resume Next

For i = 1 To 2

  Application.CommandBars("cell").Controls("KeyCheck").Delete
  
Next i

End Sub

Sub main()

Dim ie As InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")

With ie

  .Visible = True: .Top = 0: .Left = 0: .Width = 500: .Height = 500
  
End With

c = 9

Do While Sheets("検索順位").Cells(1, c).Value <> ""

  c = c + 1
  
Loop

Sheets("検索順位").Cells(1, c).Value = Month(Date) & "/" & Day(Date)

r = 2

Do While Sheets("検索順位").Cells(r, 1).Value <> ""

  Call func(r, c, ie)
  
  r = r + 1

Loop

ie.Quit
Set ie = Nothing

MsgBox "done"

End Sub

Sub func(r, c, ie As InternetExplorer)

ie.navigate "http://www.yahoo.co.jp"

Call ieWait(ie)

ie.document.getElementById("srchtxt").Value = Sheets("検索順位").Cells(r, 2).Text
ie.document.getElementById("srchbtn").Click

Call ieWait(ie)
    
If InStr(ie.document.body.innerText, Sheets("検索順位").Cells(r, 1).Text) <> 0 Then

  Sheets("検索順位").Cells(r, c) = 1
  
  DoEvents
  Sleep Int((3000 - 1000 + 1) * Rnd + 1000)
  
  Exit Sub

Else

  ie.navigate "JavaScript:scrollTo(0," & ie.document.body.ScrollHeight & ")"
      
End If

For pages = 2 To 10

  For Each anchor In ie.document.all.tags("a")
    
    If Len(anchor.Text) <= 2 And Val(anchor.Text) = pages Then
      
      ie.navigate anchor.href
      
      Call ieWait(ie)

      If InStr(ie.document.body.innerText, Sheets("検索順位").Cells(r, 1).Text) <> 0 Then
      
        Sheets("検索順位").Cells(r, c) = pages
        
        DoEvents
        Sleep Int((3000 - 1000 + 1) * Rnd + 1000)
        
        Exit Sub
        
      Else
        
        ie.navigate "JavaScript:scrollTo(0," & ie.document.body.ScrollHeight & ")"
      
      End If

      Exit For
    
    End If
  
  Next anchor
    
Next pages

DoEvents
Sleep Int((3000 - 1000 + 1) * Rnd + 1000)
        
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

'参照設定

'Microsoft HTML Object Library

'Microsoft Internet Controls

#If VBA7 Then

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)

#Else

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

#End If

Sub ieWait(obj As InternetExplorer)

Do While obj.Busy = True Or obj.ReadyState <> 4

DoEvents

Sleep 1000

Loop

Do While obj.document.ReadyState <> "complete"

DoEvents

Sleep 1000

Loop

Sleep Int((3000 - 1000 + 1) * Rnd + 1000)

End Sub

Sub auto_open()

Application.CommandBars("cell").Reset

With Application.CommandBars("cell").Controls.Add

.OnAction = "main"

.Caption = "KeyCheck"

End With

End Sub

Sub auto_close()

On Error Resume Next

For i = 1 To 2

Application.CommandBars("cell").Controls("KeyCheck").Delete

Next i

End Sub

Sub main()

Dim ie As InternetExplorer

Set ie = CreateObject("InternetExplorer.Application")

With ie

.Visible = True: .Top = 0: .Left = 0: .Width = 500: .Height = 500

End With

c = 9

Do While Sheets("検索順位").Cells(1, c).Value <> ""

c = c + 1

Loop

Sheets("検索順位").Cells(1, c).Value = Month(Date) & "/" & Day(Date)

r = 2

Do While Sheets("検索順位").Cells(r, 1).Value <> ""

Call func(r, c, ie)

r = r + 1

Loop

ie.Quit

Set ie = Nothing

MsgBox "done"

End Sub

Sub func(r, c, ie As InternetExplorer)

ie.navigate "http://www.yahoo.co.jp"

Call ieWait(ie)

ie.document.getElementById("srchtxt").Value = Sheets("検索順位").Cells(r, 2).Text

ie.document.getElementById("srchbtn").Click

Call ieWait(ie)

If InStr(ie.document.body.innerText, Sheets("検索順位").Cells(r, 1).Text) <> 0 Then

Sheets("検索順位").Cells(r, c) = 1

DoEvents

Sleep Int((3000 - 1000 + 1) * Rnd + 1000)

Exit Sub

Else

ie.navigate "JavaScript:scrollTo(0," & ie.document.body.ScrollHeight & ")"

End If

For pages = 2 To 10

For Each anchor In ie.document.all.tags("a")

If Len(anchor.Text) <= 2 And Val(anchor.Text) = pages Then

ie.navigate anchor.href

Call ieWait(ie)

If InStr(ie.document.body.innerText, Sheets("検索順位").Cells(r, 1).Text) <> 0 Then

Sheets("検索順位").Cells(r, c) = pages

DoEvents

Sleep Int((3000 - 1000 + 1) * Rnd + 1000)

Exit Sub

Else

ie.navigate "JavaScript:scrollTo(0," & ie.document.body.ScrollHeight & ")"

End If

Exit For

End If

Next anchor

DoEvents

Sleep Int((3000 - 1000 + 1) * Rnd + 1000)

End Sub

2016-09-272016-12-23

Javascript マウスでセル(テーブル)を塗る

レンサバ等でPHPファイルを作って以下を貼付ければ実行可能。
データはSQLiteに保存される。

<?php

ini_set("display_errors", "1");
ini_set("error_reporting", E_ALL);

$data = file_get_contents("php://input");
if (strlen($data) > 0){
    
    //$data_array = json_decode($data, true);
    //file_put_contents("log.txt", "value:" . $data_array["rc001001"]["value"] . ", css:" . $data_array["rc001001"]["css"]);

    //file_put_contents("log.txt",$data);
    
    if(file_exists("db.sql")){
        if ($db = sqlite_open("db.sql", 0666, $e)) {
            sqlite_query($db, "DROP TABLE tbl");
            sqlite_query($db, "CREATE TABLE tbl (col)");
            sqlite_query($db, "INSERT INTO tbl (col) VALUES ('$data')");
        } else {
            die($e);
        }     
    }else{
        if ($db = sqlite_open("db.sql", 0666, $e)) {
            sqlite_query($db, "CREATE TABLE tbl (col)");
            sqlite_query($db, "INSERT INTO tbl (col) VALUES ('$data')");
        } else {
            die($e);
        }   
    }

    //header("Content-Type: text/javascript; charset=utf-8");
    //echo $data;
    
    //$result = sqlite_query($db, "SELECT col FROM tbl");
    //var_dump(sqlite_fetch_array($result));
    
    exit();  
}

?>
<html lang="ja">
<head>
    <meta charset="utf-8">
    <style>
        body{
            margin: 0;
        }
        body, input[type="button"]{
            font-size: 11px; font-family: "メイリオ";
        }
        input[type="button"]{
            width: 100px;
            margin: 5px 0 5px 5px;
        }
        #screen{
            width: 100%; height: 100%;
            background-color: blue; opacity: 0.1;
            position: absolute; z-index: 1;
        }
        #container{
            width: 90%; height: 90%;
            overflow: scroll; -webkit-overflow-scrolling: touch;
        }
        table{
            border-collapse: collapse;
        }
        td{
            border: 1px solid #ccc;
            cursor: pointer;
            min-width: 15px; height: 15px;
        }

    </style>
    <script src="http://code.jquery.com/jquery-1.11.1.min.js"></script>
</head>
<body>
<div id="screen"></div>
<div><input type="button" id="s" value="save"><input type="button" id="c" value="cancel"></div>
<div id="container">
    <table>
    <?php
    for($r = 1; $r <= 30; $r++){
        echo "<tr>";
        for($c = 1; $c <= 30; $c++){
            echo '<td class="r' . str_pad($r,3,0,STR_PAD_LEFT) . ' ' . 'c' . str_pad($c,3,0,STR_PAD_LEFT) . '" ';
            echo 'id="' . 'rc' . str_pad($r,3,0,STR_PAD_LEFT) . str_pad($c,3,0,STR_PAD_LEFT) . '">';
            echo '';
            echo '</td>';
        }
        echo "</tr>";
    }
    ?>
    </table>
    <p>
        ctrlを押しながらマウスを動かすと書ける。shiftを押しながらマウスを動かすと消せる。<br>
        セルをクリックするとテキスト入力できる。enterかescかフォーカスを抜くと確定(キャンセル処理はなし)。
    </p>
</div>

<script>

$("input#s").on("click",function(){
    
    $("input#s, input#c").attr("disabled","");
    
    var data = {};
    var id;
    
    for(var r = 1; r <= 30; r++){
        for(var c = 1; c <= 30; c++){
            id = "rc" + ("00" + r).slice(-3) + ("00" + c).slice(-3) + "";
            data[id] = {
                "value": $("#" + id + "").text(),
                "css": $("#" + id + "").css("background-color")
            };
        }
    }
    //contentType: "application/json", dataType: "json", data: JSON.stringify(data),
    $.ajax({
        type: "post", url: "", async: true, dataType: "text", data: JSON.stringify(data),   
        success: function(data){
            //console.log(data);
            alert("OK");
            $("input#s, input#c").attr("disabled", false);
            
            window.location.reload();
            
        },error: function(){
            alert("NG");
            $("input#s, input#c").attr("disabled", false);
        }
    });
    
});

$("input#c").on("click",function(){
    window.location.reload();
});

$("td").on("mousemove",function(i){
    if (i.ctrlKey) {
        $(this).css("background-color","#ccc");
    } else if (i.shiftKey) {
        $(this).css("background-color","white");
    }
});

$("td").on("click", function(i){
    $("<input></input>",{
        "type": "text",
        "value": $(i.target).text(),
        "css": {
            "position": "absolute", "z-index": "1",
            "top": i.pageY, "left": i.pageX
        }
    }).on("keydown", function(k){
            if (k.keyCode === 13 || k.keyCode === 27) {
                $(i.target).text( $(this).val() );
                $(this).remove();
            }
    }).appendTo("body").focus().blur(function(){
        $(i.target).text( $(this).val() );
        $(this).remove();    
    });
});

$(window).on("load",function(){
    $("#screen").hide();
});

</script>
<?php
if(file_exists("db.sql")){
    if ($db = sqlite_open("db.sql", 0666, $e)) {
        $row = sqlite_fetch_array(sqlite_query($db, "SELECT col FROM tbl"));
        echo "<script>";
        echo "var result = $row[0];";
        echo "</script><script>";
        
        echo 'for(var r = 1; r <= 30; r++){
                for(var c = 1; c <= 30; c++){
                    var id = "rc" + ("00" + r).slice(-3) + ("00" + c).slice(-3) + "";
                    $("#" + id + "").css("background-color", result[id].css);
                    $("#" + id + "").text(result[id].value);             
                }
        }';
        echo "</script>";
    }  
}
?>
</body>
</html>

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

<?php

ini_set("display_errors", "1");

ini_set("error_reporting", E_ALL);

$data = file_get_contents("php://input");

if (strlen($data) > 0){

//$data_array = json_decode($data, true);

//file_put_contents("log.txt", "value:" . $data_array["rc001001"]["value"] . ", css:" . $data_array["rc001001"]["css"]);

//file_put_contents("log.txt",$data);

if(file_exists("db.sql")){

if ($db = sqlite_open("db.sql", 0666, $e)) {

sqlite_query($db, "DROP TABLE tbl");

sqlite_query($db, "CREATE TABLE tbl (col)");

sqlite_query($db, "INSERT INTO tbl (col) VALUES ('$data')");

} else {

die($e);

}

}else{

if ($db = sqlite_open("db.sql", 0666, $e)) {

sqlite_query($db, "CREATE TABLE tbl (col)");

sqlite_query($db, "INSERT INTO tbl (col) VALUES ('$data')");

} else {

die($e);

}

//header("Content-Type: text/javascript; charset=utf-8");

//echo $data;

//$result = sqlite_query($db, "SELECT col FROM tbl");

//var_dump(sqlite_fetch_array($result));

exit();

}

<head>

<style>

body{

margin: 0;

}

body, input[type="button"]{

font-size: 11px; font-family: "メイリオ";

}

input[type="button"]{

width: 100px;

margin: 5px 0 5px 5px;

}

#screen{

width: 100%; height: 100%;

background-color: blue; opacity: 0.1;

position: absolute; z-index: 1;

}

#container{

width: 90%; height: 90%;

overflow: scroll; -webkit-overflow-scrolling: touch;

}

table{

border-collapse: collapse;

}

td{

border: 1px solid #ccc;

cursor: pointer;

min-width: 15px; height: 15px;

}

</style>

</head>

<body>

<table>

<?php

for($r = 1; $r <= 30; $r++){

echo "<tr>";

for($c = 1; $c <= 30; $c++){

echo '<td class="r' . str_pad($r,3,0,STR_PAD_LEFT) . ' ' . 'c' . str_pad($c,3,0,STR_PAD_LEFT) . '" ';

echo 'id="' . 'rc' . str_pad($r,3,0,STR_PAD_LEFT) . str_pad($c,3,0,STR_PAD_LEFT) . '">';

echo '';

echo '</td>';

}

echo "</tr>";

}

</table>

<p>

ctrlを押しながらマウスを動かすと書ける。shiftを押しながらマウスを動かすと消せる。<br>

セルをクリックするとテキスト入力できる。enterかescかフォーカスを抜くと確定(キャンセル処理はなし)。

</p>

</div>

$("input#s").on("click",function(){

$("input#s, input#c").attr("disabled","");

var data = {};

var id;

for(var r = 1; r <= 30; r++){

for(var c = 1; c <= 30; c++){

id = "rc" + ("00" + r).slice(-3) + ("00" + c).slice(-3) + "";

data[id] = {

"value": $("#" + id + "").text(),

"css": $("#" + id + "").css("background-color")

};

}

//contentType: "application/json", dataType: "json", data: JSON.stringify(data),

$.ajax({

type: "post", url: "", async: true, dataType: "text", data: JSON.stringify(data),

success: function(data){

//console.log(data);

alert("OK");

$("input#s, input#c").attr("disabled", false);

window.location.reload();

},error: function(){

alert("NG");

$("input#s, input#c").attr("disabled", false);

}

});

$("input#c").on("click",function(){

window.location.reload();

});

$("td").on("mousemove",function(i){

if (i.ctrlKey) {

$(this).css("background-color","#ccc");

} else if (i.shiftKey) {

$(this).css("background-color","white");

}

});

$("td").on("click", function(i){

$("<input></input>",{

"type": "text",

"value": $(i.target).text(),

"css": {

"position": "absolute", "z-index": "1",

"top": i.pageY, "left": i.pageX

}

}).on("keydown", function(k){

if (k.keyCode === 13 || k.keyCode === 27) {

$(i.target).text( $(this).val() );

$(this).remove();

}

}).appendTo("body").focus().blur(function(){

$(i.target).text( $(this).val() );

$(this).remove();

});

$(window).on("load",function(){

$("#screen").hide();

});

</script>

<?php

if(file_exists("db.sql")){

if ($db = sqlite_open("db.sql", 0666, $e)) {

$row = sqlite_fetch_array(sqlite_query($db, "SELECT col FROM tbl"));

echo "<script>";

echo "var result = $row[0];";

echo "</script><script>";

echo 'for(var r = 1; r <= 30; r++){

for(var c = 1; c <= 30; c++){

var id = "rc" + ("00" + r).slice(-3) + ("00" + c).slice(-3) + "";

$("#" + id + "").css("background-color", result[id].css);

$("#" + id + "").text(result[id].value);

}

}';

echo "</script>";

}

</body>

</html>